平面图、详图构件编号校核

dyjwyqz5221

结构设计人员在校核平面图、详图编号是否一致时，是非常苦恼的事情，
分享结构设计人员一款小插件，希望大家喜欢。

编号类型，可以自己添加。

准确查找出平面图及详图中不一致的编号，并用表格表示
自动去除编号中的空格及非编号的符号，如：*、括号等。
表格自动炸开。
平面图、详图不一致处，在表格左右两侧自动注写不一致的编号


需采用最新版本的xdrx api
一个文字中包含两个及两个以上编号时，禁止采用空格将其分割，否则提取的编号有问题。

2020.06.24修改

[Actionscript3] 纯文本查看 复制代码

(defun c:chk-bh(/ str lst ss-pm ss-xt)
        (defun get::lst (ss str)
                (XD::List:RemoveDup 
                            (apply 'append
                                (mapcar
                                            '(lambda(x)
                                                (mapcar
                                                            '(lambda(y)
                                                                (list y str)
                                                            )
                                                            (yqz::clean:text x)
                                                );;;mapcar
                                            )
                                            (xdrx_entity_getproperty ss "textstring")
                                );;;mapcar
                            )
                )
            );;;defun
            (defun yqz::Text:Init ()
                (if (not (xdrx_object_get "style" "yqz-style"))
                        (xdrx_textstyle_make "yqz-style" "tssdeng.shx" "hztxt.shx" 250. 0.7)
                );;;if
                    (setvar "textstyle" "yqz-style")
            );;;defun
            (defun yqz::clean:text (str)
                (setq str (xdrx_string_regexpr "\\s+" str ""))
                (xdrx_string_regexps "[a-z\\-\\0-9]+" str)
            );;;defun
            ;;;表格处理
            (defun processing-table (ss / lst lst-text)
                    (xdrx_setmark)
                    (xdrx_entity_explode t ss);;;一炸到底，不用进行二次炸开
                    (setq ss (xdrx_getss))
                (xdrx_entity_setproperty ss "color" 7);;;文字及直线变颜色
                (setq lst (xdrx_pickset->ents ss)
                            lst-text
                            (vl-remove-if-not
                                '(lambda(x)
                                            (xdrx_object_isa x "AcDbtext")
                                );;;lambda
                                lst
                            );;;vl
                );;;setq
                (mapcar
                            '(lambda(x)
                                (xdrx_setpropertyvalue x "Textstring" (xdrx_string_regexpr "%%%%%%" (xdrx_text_string x) "%%" "");;;替换完字符串后，这样就可以返回图形。
                                            "HorizontalMode" 1;;;水平居中
                                            "VerticalMode" 2;;;竖向居中
                                        "AlignmentPoint" (XD::Geom:Get9PT x 5);;;文字居中位置
                                )
                            );;;lambda
                            lst-text
                );;;mapcar
            );;;defun
            ;;;制作实体表格程序
            (defun _maketable(lst)
                (yqz::Text:Init)
                    (xd::table:makefromlist lst '(0. 0. 0.) 250. 100.)
            );;;defun
            (defun _make::mark (lst pt str pos col / ss)
                (setq ss (ssget "cp" box (list '(0 . "text")(cons 1 (XD::List->String lst ",")))))
                (xdrx_entity_setproperty ss "color" col)
                (xdrx_setmark)
                (mapcar
                            '(lambda (x / box pt-mid)
                                (setq box (xdrx_text_box x)
                                            pt-mid (xdrx_points_centroid box)
                                )
                                (xdrx_line_make pt-mid pt)
                            );;;lambda
                            (xdrx_pickset->ents ss)
                );;;mapcar
                (xdrx_entity_setproperty (xdrx_getss) "layer" "chk-bhtable" "color" 3)
                (xdrx_entity_setproperty 
                            (XD::Text:Make (list pt) 
                                            str
                                            "yqz-style"
                                            600.
                                            0.70
                                            0.00
                                            pos
                            )
                            "layer" "chk-bhtable"
                            "color" 2
                )
            );;;defun
            (defun _pross (ss-pm ss-xt / lst-pm lst-xt lst lst-no-left lst-no-right ss box pt7 pt9)
                (xdrx_begin)
                (xdrx_sysvar_push '("osmode" 0 "cmdecho" 0 "Pickstyle" 0));;;捕捉和命令关闭
                (setq lst-pm (get::lst ss-pm "平面")
                            lst-xt (get::lst ss-xt "详图")
                            lst (xd::list:groupbyindex (append lst-pm lst-xt) 1e-3)
                            lst
                            (vl-sort lst
                                '(lambda(a b)
                                            (xdrx-string-logical< (car a) (car b))
                                );;;lambda
                            );;;vl
                            lst
                            (mapcar
                                '(lambda(x / a11 a12 len)
                                            (setq a11 (car x)
                                                a12 (cadr x)
                                                len (length x)
                                            );;;setq
                                            (cond 
                                                ((= len 3)
                                                            (list a11 a11)
                                                );;
                                                ((= len 2)
                                                            (cond
                                                                ((= a12 "平面")
                                                                            (setq lst-no-right (cons a11 lst-no-right))
                                                                            (list a11 "")
                                                                )
                                                                (t
                                                                            (setq lst-no-left (cons a11 lst-no-left))
                                                                            (list "" a11)
                                                                )
                                                            );;;cond
                                                );;
                                            );;;cond
                                );;;lambda
                                lst
                            );;;mapcar
                            lst
                            (append 
                                (list
                                            (list "构件编号比对表" "")
                                            (list "平面图" "详图")
                                );;;list
                                lst
                            );;;append                  
                );;;setq
                (_maketable lst)
                (xd::drag:move "\n表格插入点:" (entlast) 5 7)
                (setq ss (entlast)
                           box (xdrx_entity_box ss)
                            pt7 (mapcar '+ (last box) '(-1000. 1000. 0.))
                            pt9 (mapcar '+ (caddr box) '(1000. 1000. 0.))
                );;;setq
                (processing-table ss);;;表格处理程序，炸开、文字替换、文字直线变颜色
                (xdrx_document_redraw)
                (if (and (not lst-no-left) (not lst-no-right))
                            (xdrx_prompt "\n恭喜：平面图与详图编号一致！")
                            (progn
                                (if lst-no-left
                                            (_make::mark lst-no-left pt9 (strcat *chk-bhtable* (XD::List->String (xdrx_list_sort lst-no-left) "、") "详图多余，在平面图中未找到") "ML" 1)
                                );;;if
                                (if lst-no-right
                                            (_make::mark lst-no-right pt7 (strcat *chk-bhtable* (XD::List->String (xdrx_list_sort lst-no-right) "、") "无详图") "MR" 4)  
                                );;;if
                            );;;progn
                );;;if
                (xdrx_sysvar_pop)
                (xdrx_end)
                (princ)
            );;;defun
            (if (not *chk-bhtable*)
                (setq *chk-bhtable* "框架柱")
            );;;if
            (if (and (setq *chk-bhtable* (xdrx_ui_combolist "构件类型" "选择构件类型" '("边缘构件" "框架柱") *chk-bhtable*))
                (member *chk-bhtable* '("边缘构件" "框架柱"))
                );;;and
                (progn
                            (cond
                                ((= *chk-bhtable* "边缘构件")
                                            (setq str "*BZ*,*JZ*")
                                )
                                (t
                                            (setq str "*KZ*,*LZ*,*QZ*")
                                )
                            );;;cond
                            (setq lst (list '(0 . "text")(cons 1 str)))
                            (while (and (xdrx-setvar "picksethome" 2) 
                                        (setq ss-pm (xdrx-ssget "\n框选平面图:" ":L" lst))
                                        (xdrx-setvar "picksethome" 3) 
                                        (setq ss-xt (xdrx_ssget "\n框选详图:" ":L" lst))
                                );;;and
                                (_pross ss-pm ss-xt)
                        );;;while
                );;;progn
                (setq *chk-bhtable* "边缘构件")
            );;;if
            (princ)
);;;defun

dyjwyqz5221

有点小问题，我下午查一下

dyjwyqz5221

标注处有点问题，已经修改过来了。

newer

dyjwyqz5221 发表于 2020-6-15 11:53
标注处有点问题，已经修改过来了。

能否传上来一张测试图

dyjwyqz5221

好的，马上上传，后面表格处理有点小问题，我修改一下。

dyjwyqz5221

newer 发表于 2020-6-15 15:44
能否传上来一张测试图

测试图，是天正软件绘制的，不知道你那里能够能打开？

xk15c

看看是什么情况

newer

dyjwyqz5221 发表于 2020-6-15 16:54
测试图，是天正软件绘制的，不知道你那里能够能打开？

转T3后，代码不能用吗？

kmliro_2017

谢谢分享！！！！

czb203

看起来很神奇的样子

dyjwyqz5221

newer 发表于 2020-6-16 01:31
转T3后，代码不能用吗？

(defun c:tt(/ str lst ss-pm ss-xt)
        (if (not *chk-bhtable*)
                (setq *chk-bhtable* "边缘构件")
        );;;if
        (if (setq *chk-bhtable* (xdrx_ui_combolist "构件类型" "选择构件类型" '("边缘构件" "框架柱") *chk-bhtable*))
                (progn
                        (cond
                                ((= *chk-bhtable* "边缘构件")
                                        (setq str "*[BJ]Z*")
                                )
                                (t
                                        (setq str "*[KLQ]Z*")
                                )
                        );;;cond
                        (setq lst (list ":L" (list '(0 . "text")(cons 1 str))))
                        (and (setq ss-pm (xd::ssget "\n框选平面图:" lst)) (setq ss-xt (xd::ssget "\n框选详图:" lst)))        
                );;;progn
        );;;if
);;;defun

这是上面程序中的一段，对话框早先采用的是dioslib函数，现在修改为xdrx api函数了。
测试中发现，复制黏贴到cad命令行时，不会出现错误提示，
但是采用工具->加载应用程序 时，就出现了错误提示：
输入的字符串有缺陷

经过测试发现，将程序的红色部分去掉就没问题了
这说明是函数xdrx_ui_combolist后面的参数有问题，是不是不能带变量呀？

dyjwyqz5221

测试的cad图一会我给转成T3，程序我再调整下。重新放上去。
上面我的问题，你测试下，是不是这样。

既然青春留不住

dyjwyqz5221

我也是醉了，复制黏贴代码到cad没问题，用应用程序加载就有问题。测试了一上午也不知道哪里的问题
代码都调整好了。欢迎测试。

cad T3测试图稍后上传

意思哥

昨天试了下好像没反应，不知道啥原因，有空再试试！