设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1207|回复: 30

[工具] 平面图、详图构件编号校核

[复制链接]

已领礼包: 189个

财富等级: 日进斗金

发表于 2020-6-15 10:46:37 | 显示全部楼层 |阅读模式
  • 插件名称 : 平面图、详图构件编号比较
  • 作  者 : dyjwyqz5221
  • 运行环境 :XDRX API 
  • 发布时间 :2020-06-15
  • 命令名称 :chk-bh
  • 插件介绍 :准确查找出平面图及详图中不一致的编号,并用表格表示
    自动去除编号中的空格及非编号的符号,如:*、括号等。
    表格自动炸开。
    平面图、详图不一致处,在表格左右两侧自动注写不一致的编号
  • 备  注 : (点击图片可以放大)
    需采用最新版本的xdrx api
    一个文字中包含两个及两个以上编号时,禁止采用空格将其分割,否则出错。
(点击图片可以放大)

晓东温馨提示 1、运行环境为 晓东工具箱XDRX API 的插件,请下载最新版本的 晓东工具箱XDRX API开发环境 一键安装
2、在ACAD中如何加载插件,请看 论坛插件使用方法
3、如果您有要求需要定制插件,请到 编程申请 论坛发帖求助

插件详细内容

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
本帖最后由 dyjwyqz5221 于 2020-6-24 18:20 编辑

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

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

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


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

2020.06.24修改

[mw_shl_code=actionscript3,true](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
[/mw_shl_code]
编号比对.png

测试图_t3.rar

61.33 KB, 下载次数: 8, 下载积分: D豆 -1 , 活跃度 1

评分

参与人数 2D豆 +10 收起 理由
newer + 5 很给力!经验;技术要点;资料分享奖!
Lispboy + 5 很给力!经验;技术要点;资料分享奖!

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 189个

财富等级: 日进斗金

 楼主| 发表于 2020-6-15 11:20:58 | 显示全部楼层
有点小问题,我下午查一下
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 189个

财富等级: 日进斗金

 楼主| 发表于 2020-6-15 11:53:06 | 显示全部楼层
标注处有点问题,已经修改过来了。

点评

能否传上来一张测试图  详情 回复 发表于 2020-6-15 15:44
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2020-6-15 15:44:56 | 显示全部楼层
dyjwyqz5221 发表于 2020-6-15 11:53
标注处有点问题,已经修改过来了。

能否传上来一张测试图

点评

程序已经修改。也附加上了T3图,请测试!  详情 回复 发表于 2020-6-17 09:43
测试图,是天正软件绘制的,不知道你那里能够能打开?  详情 回复 发表于 2020-6-15 16:54
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 189个

财富等级: 日进斗金

 楼主| 发表于 2020-6-15 16:40:00 | 显示全部楼层
好的,马上上传,后面表格处理有点小问题,我修改一下。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 189个

财富等级: 日进斗金

 楼主| 发表于 2020-6-15 16:54:08 | 显示全部楼层
newer 发表于 2020-6-15 15:44
能否传上来一张测试图

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

测试图.rar

128.05 KB, 下载次数: 1, 下载积分: D豆 -1 , 活跃度 1

点评

转T3后,代码不能用吗?  详情 回复 发表于 2020-6-16 01:31
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 914个

财富等级: 财运亨通

发表于 2020-6-16 00:01:46 | 显示全部楼层
看看是什么情况
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2020-6-16 01:31:28 | 显示全部楼层
dyjwyqz5221 发表于 2020-6-15 16:54
测试图,是天正软件绘制的,不知道你那里能够能打开?

转T3后,代码不能用吗?

点评

从未出现过的奇怪现象,就这样发生了: 下面的测试,应该没有问题的 (defun c:tt(/ str lst ss-pm ss-xt) (if (not *chk-bhtable*) (setq *chk-bhtable* "边缘构件") );;;if  详情 回复 发表于 2020-6-16 14:16
(defun c:tt(/ str lst ss-pm ss-xt) (if (not *chk-bhtable*) (setq *chk-bhtable* "边缘构件") );;;if (if (setq *chk-bhtable* (xdrx_ui_combolist "构件类型" "选择构件类型" '("边缘构件" "框架柱") *  详情 回复 发表于 2020-6-16 08:26
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 225个

财富等级: 日进斗金

发表于 2020-6-16 07:14:17 | 显示全部楼层
谢谢分享!!!!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

已领礼包: 41个

财富等级: 招财进宝

发表于 2020-6-16 08:04:29 | 显示全部楼层
看起来很神奇的样子
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 189个

财富等级: 日进斗金

 楼主| 发表于 2020-6-16 08:26:48 | 显示全部楼层
本帖最后由 dyjwyqz5221 于 2020-6-16 08:36 编辑
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后面的参数有问题,是不是不能带变量呀?


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 189个

财富等级: 日进斗金

 楼主| 发表于 2020-6-16 08:32:53 | 显示全部楼层
测试的cad图一会我给转成T3,程序我再调整下。重新放上去。
上面我的问题,你测试下,是不是这样。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 166个

财富等级: 日进斗金

发表于 2020-6-16 08:47:09 | 显示全部楼层
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

已领礼包: 189个

财富等级: 日进斗金

 楼主| 发表于 2020-6-16 11:08:56 | 显示全部楼层
我也是醉了,复制黏贴代码到cad没问题,用应用程序加载就有问题。测试了一上午也不知道哪里的问题
代码都调整好了。欢迎测试。

cad T3测试图稍后上传
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 27个

财富等级: 恭喜发财

发表于 2020-6-16 11:38:07 | 显示全部楼层
昨天试了下好像没反应,不知道啥原因,有空再试试!

点评

重新下载下 API ,安装完后,在下载通用LISP函数库,覆盖 再测试下情况  详情 回复 发表于 2020-6-16 14:38
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2021-9-23 01:56 , Processed in 0.906512 second(s), 72 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表