找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1843|回复: 17

[多段线] 重生成多段线表格线框(使用于结构专业)

[复制链接]

已领礼包: 199个

财富等级: 日进斗金

发表于 2020-8-6 11:35:54 | 显示全部楼层 |阅读模式
  • 插件名称 : 表格线框
  • 作  者 : dyjwyaz5221
  • 运行环境 :XDRX API 
  • 发布时间 :2020-08-06
  • 命令名称 :get-tab
  • 插件介绍 :适用于结构专业框架柱、剪力墙边缘构件表格
  • 备  注 : (点击图片可以放大)
(点击图片可以放大)

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

插件详细内容

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

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

×
本帖最后由 dyjwyqz5221 于 2020-8-6 16:50 编辑

;;;使用最新的api函数API2020.08.05
;;;修改于2020.8.6
;;;作者自测后评语:

;;;对有无表头均使用,无表头时,仅为一排才可。
;;;对多个不同的表格,宽度不同、连接在一起的、不连接在一起的均适用。
;;;各表格之间表头可以不一致,但是里面应仅有一个"面"字。
;;;其他表格不应在本表格的正包围盒范围内。
;;;适应于表格线为多段线、直线或者其混合的均可,中间有多条线重合时也可。
;;;这是目前最好的一个命令,适应范围广,基本解决了所有表格边框变多段线的问题,图层、颜色均已定义好,
;;;且将各自的9点包围盒均纳入了里面,生成的表格多段线无重复,无需判断。

第二版,前版程序有点复杂,进行了修改,这样选择就相对少了,并且有些做了合并,效率更高了,逻辑关系也更明确了。
        
命令: get-tab
拾取“详图表格框”确定图层<返回>:
拾取“详图表格框”确定图层<返回>:
拾取“详图表格框”确定图层<返回>:
框选详图表格线框<退出>:指定对角点: 找到 118 个
框选详图表格线框<退出>:
恭喜:共生成 73 个闭合多段线表格线框。
执行时间:0.2s.
框选详图表格线框<退出>:

多个表格一次性生成,方便后续的程序制作
表格线为多段线、直线混合,多个表格合在一起也能自己区分。

为大家测试方便,自定义函数都全部加上了。

[Actionscript3] 纯文本查看 复制代码
(defun c:get-tab(/ ss-tab lyr XD::List:subtract XD::pnts:RemoveDup get::pts get::pts1 get::pts2 _pross1 _pross)
        ;;;两个表的差(无容差):lst-lst1
        (defun XD::List:subtract(lst lst1)
                (mapcar
                        '(lambda(x)
                                    (setq lst (vl-remove x lst))
                           )
                        lst1
                   )
                   lst
        );;;defun
        ;;;有容差的点表消重
        (defun XD::pnts:RemoveDup(lst fuzz / foo index)
                    (defun foo (x)
                        (cond
                                    ((xd::list:member-fuzz x index fuzz))
                                    ((null (setq index (cons x index))))
                        )
                    );;;defun
                    (vl-remove-if
                               'foo
                        lst
                    );;;vl
        );;;defun
        ;;;求连在一起表格线的包围盒
        (defun get::pts(ss-tab / lst e lst-box-ss pts lst1)
                (defun get::box:ss(e / ss-pl n1 n2 pts)
                        (setq ss-pl (ssadd)
                                ss-pl (ssadd e ss-pl)
                                n1 0
                                n2 1
                        );;;setq
                        (while (> n2 n1)
                                (setq n1 (sslength ss-pl)
                                        pts (xdrx-entity-box ss-pl)
                                );;;setq
                                (if (equal (xdrx-points-area pts) 0.)
                                        (setq pts (xdrx-points->offsetbox pts 100.))
                                        (setq pts (xdrx_points_offset 100. (XD::PnTs:Close pts)))
                                );;;if
                                (setq ss-pl (ssget "cp" pts (list '(0 . "lwpolyline,line")(cons 8 lyr)))
                                        n2 (sslength ss-pl)
                                );;;setq
                        );;;while
                        (list (xdrx-entity-box ss-pl) ss-pl)
                );;;defun
                (setq lst (xdrx-pickset->ents ss-tab))
                (while (setq e (car lst))
                        (setq lst-box-ss (get::box:ss e)
                                pts (cons (car lst-box-ss) pts)
                                lst1 (xdrx-pickset->ents (cadr lst-box-ss))
                                lst (XD::List:subtract lst lst1)
                        );;;setq
                );;;while
                pts
        );;;defun
        ;;;取子表格竖向分隔点坐标
        (defun get::pts1(pts-y n m / n1 ptss)
                (setq n1 0)
                (while (<= n1 n)
                        (setq ptss (cons (nth (- (* n1 m) n1) pts-y) ptss))
                        (setq n1 (1+ n1))
                );;;repeat
                (reverse ptss)
        );;;defun
        (defun get::pts2(pts pm1 pm2)
                (setq pts
                        (XD::List:SnakePair
                                (mapcar
                                        '(lambda(y)
                                                (list
                                                        (xdrx-point-orthoproject y pm1)
                                                        (xdrx-point-orthoproject y pm2)
                                                );;;list
                                        );;;lambda
                                        pts
                                );;;mapcar
                        );;;xd
                );;;setq
                (mapcar
                        '(lambda(y)
                                (append (car y) (reverse (cadr y)))
                        );;;lambda
                        pts
                );;;mapcar
        );;;defun
        (defun _pross1(pts)
                (mapcar
                        '(lambda(x / ss e txt col)
                                (setq ss (ssget "cp" x '((0 . "text")(1 . "*Z*,*面*"))))
                                (if ss
                                        (progn
                                                (setq e (xdrx-polyline-make x t))
                                                (setq txt (car (xdrx-entity-getproperty ss "textstring")))
                                                (cond
                                                        ((xdrx-string-find1 txt "Z") 
                                                                (cond
                                                                        ((xdrx-string-find1 txt "K")
                                                                                (setq col 2)
                                                                                (xdrx-xdata-set e "tab-9pt" pts-9pt)
                                                                                (setq tf nil)
                                                                                (setq nn (1+ nn))
                                                                        );;;cond1
                                                                        ((or (xdrx-string-find1 txt "G") (xdrx-string-find1 txt "Y"))
                                                                                (setq col 6)
                                                                                (xdrx-xdata-set e "tab-9pt" pts-9pt)
                                                                                (setq tf nil)
                                                                                (setq nn (1+ nn))
                                                                        );;;cond2
                                                                );;;cond
                                                        );;;cond1
                                                        ((xdrx-string-find1 txt "面")
                                                                (setq col 4)
                                                                (setq nn (1+ nn))
                                                        );;;cond2
                                                );;;cond
                                                (xdrx-entity-setproperty e "layer" "0-表格线框" "color" col "ConstantWidth" 30.)
                                        );;;progn
                                );;;if
                        );;;lambda
                        pts
                );;;mapcar
        );;;defun
        (defun _pross(ss-tab lyr / nn pts pts-n tf n nn)
                (xdrx-begin)
                     (xdrx-sysvar-push '("osmode" 0 "xdatawritemode" 4));;;捕捉和命令关闭
                (setq nn 0)
                (if (setq pts (get::pts ss-tab));;;得到独立的表格线框最大包围盒。
                        (progn
                                ;;;找出连在一起的表格中有几个子表格
                                (setq pts-n
                                        (mapcar
                                                '(lambda(x / ss-txt)
                                                        (setq ss-txt (ssget "cp" x '((0 . "text")(1 . "*面*"))))
                                                        (if ss-txt
                                                                (list x (sslength ss-txt))
                                                                (list x 1)
                                                        );;;if
                                                );;;lambda
                                                pts
                                        );;;mapcar
                                );;;setq
                                (mapcar
                                        '(lambda(x / box pm-left pm-right n pts pts-left pts-y n-y m)
                                                (setq box (car x);;;表格大的包围盒
                                                        pm-left (list (car box) '(1. 0. 0.))
                                                        pm-right (list (cadr box) '(1. 0. 0.))
                                                        n (last x);;;表格数量
                                                );;;setq
                                                (if (= n 1)
                                                        (setq pts (list (reverse box)));;;仅一个表格时
                                                        ;;;多个表格连在一起时,得考虑个表格之间竖向间距不一致的问题。修改之
                                                        (progn
                                                                (setq pts-left (xdrx-points-offset 100. (list (car box) (last box)))
                                                                        pts-y (xd::pnts:removedup (xdrx-getinters pts-left ss-tab 0) 50.)
                                                                        ;;;点从上到下排序后
                                                                        pts-y
                                                                        (vl-sort pts-y
                                                                                '(lambda(a b)
                                                                                        (> (cadr a) (cadr b))
                                                                                );;;lambda
                                                                        );;;vl
                                                                        n-y (length pts-y)
                                                                        m (fix (/ (1- (+ n-y n)) n))
                                                                        ;;;取中间分隔点,肯定是连在一起的。
                                                                        pts-y (get::pts1 pts-y n m)
                                                                        ;;;向左右平面投影,求交点
                                                                        pts (get::pts2 pts-y pm-left pm-right)
                                                                );;;setq
                                                        );;;progn
                                                );;;if
                                                ;;;每个子表包围盒求出后,就该计算到底有多少个水平方向的竖向线了。
                                                ;;;小包围盒的中点水平直线与ss-tab的直接交点,误差范围内消重,排序后,
                                                ;;;向top、bottom平面做垂直点。然后再组合成对形成小的包围盒。
                                                (mapcar
                                                        '(lambda(y / pts-9pt pm-top pm-bottom pt-mid pts-line pts tf)
                                                                (setq pts-9pt (xdrx-getpropertyvalue y "9pt")
                                                                        pm-top (list (last y) '(0. 1. 0.))
                                                                        pm-bottom (list (car y) '(0. 1. 0.))
                                                                        pt-mid (xdrx-points-centroid y);;;点表的中心
                                                                        pts-line (list pt-mid (mapcar '+ pt-mid '(100. 0. 0)))
                                                                        pts-line (xdrx-getinters pts-line (XD::PnTs:Close y) 3);;;得出过中点的一条水平线。
                                                                        pts (xdrx-getinters pts-line ss-tab 0);;;在求与ss-tab的直接交点。
                                                                        pts (xd::pnts:removedup pts 50.);;;50mm范围内的点做为误差范围,消重
                                                                        ;;;按x坐标由小到大水平排序
                                                                        pts
                                                                        (vl-sort pts
                                                                                '(lambda(a b)
                                                                                        (< (car a) (car b))
                                                                                );;;lambda
                                                                        );;;vl
                                                                        pts (get::pts2 pts pm-top pm-bottom)
                                                                        tf t
                                                                );;;setq
                                                                (_pross1 pts)
                                                        );;;lambda
                                                        pts
                                                );;;mapcar                        
                                        );;;lambda
                                        pts-n
                                );;;mapcar
                        );;;progn
                );;;if
                (xdrx_prompt "\n恭喜:共生成 " nn " 个闭合多段线表格线框。")
                (xdrx-sysvar-pop);;;恢复原设置
                (xdrx-end t)
                (princ)
        );;;defun
        ;;;(**error-set**)
        (if (/= "" (setq lyr (XD::Layer:Get)))
                (while (setq ss-tab (xdrx-ssget "\n框选详图表格线框<退出>:" ":L" (list '(0 . "lwpolyline,line")(cons 8 lyr))))
                        (_pross ss-tab lyr)
                );;;while
        );;;if
        (princ)
);;;defun
100000001.png

测试图_t3.rar

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

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

已领礼包: 199个

财富等级: 日进斗金

 楼主| 发表于 2020-8-6 15:05:01 | 显示全部楼层
XD::Layer:Get1函数是自己函数XD::Layer:Get基础上修改的一个函数,可以进行过滤选择了,此处可以采用XD::Layer:Get
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 199个

财富等级: 日进斗金

 楼主| 发表于 2020-8-6 15:11:18 | 显示全部楼层
命令: get-tab
拾取“详图表格框”确定图层<返回>:
拾取“详图表格框”确定图层<返回>:
拾取“详图表格框”确定图层<返回>:
框选详图表格线框<退出>:指定对角点: 找到 118 个
框选详图表格线框<退出>:
恭喜:共生成 73 个闭合多段线表格线框。
执行时间:0.136s.
框选详图表格线框<退出>:
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 199个

财富等级: 日进斗金

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

使用道具 举报

已领礼包: 199个

财富等级: 日进斗金

 楼主| 发表于 2020-8-6 15:23:32 | 显示全部楼层
(**error-set**)是我自己写的一个错误处理函数,未添加,可以去掉。其余函数基本都是用的api函数、lsp函数了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 199个

财富等级: 日进斗金

 楼主| 发表于 2020-8-6 15:37:23 | 显示全部楼层
本程序中,函数get::pts为获取哪些表格线是连接在一起的,对其他程序也是适用的。里面又好多内容可以借鉴。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2020-8-6 15:57:32 | 显示全部楼层
图不全?

(xdrx-geom-searchregions (ssget '((0 . "line"))))

这行,就把表格做出来了

点评

将表格线全部炸开后,用xdrx-geom-searchregions函数测试了下, 存在下列问题: 1、速度很慢 2、生成的图形如附图,不符合要求,不能使用。  详情 回复 发表于 2020-8-6 16:35
是测试图cad上传错了,已经修改过来了。 另外附加函数 ;;;两个表的差(无容差):lst-lst1 (defun XD::List:subtract(lst lst1) (mapcar '(lambda(x) (setq lst (vl-remove x lst)) ) lst1  详情 回复 发表于 2020-8-6 16:19
我看下测试图,  详情 回复 发表于 2020-8-6 16:07
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 199个

财富等级: 日进斗金

 楼主| 发表于 2020-8-6 16:07:28 | 显示全部楼层
newer 发表于 2020-8-6 15:57
图不全?

(xdrx-geom-searchregions (ssget '((0 . "line"))))

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

使用道具 举报

已领礼包: 199个

财富等级: 日进斗金

 楼主| 发表于 2020-8-6 16:19:02 | 显示全部楼层
本帖最后由 dyjwyqz5221 于 2020-8-6 16:25 编辑

是测试图cad上传错了,已经修改过来了。
另外附加函数
;;;两个表的差(无容差):lst-lst1
(defun XD::List:subtract(lst lst1)
        (mapcar
                '(lambda(x)
                            (setq lst (vl-remove x lst))
                   )
                lst1
           )
           lst
);;;defun

要求的结果不一样,直接用xdrx-geom-searchregions出来的结果不能满足要求。
要求:见附图,这样成为一个边框,目的是要将其编号、详图、箍筋、纵筋等信息都各自包含在自己的范围内。




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

使用道具 举报

已领礼包: 20个

财富等级: 恭喜发财

发表于 2020-8-6 16:34:38 | 显示全部楼层
dyjwyqz5221 发表于 2020-8-6 16:19
是测试图cad上传错了,已经修改过来了。
另外附加函数
;;;两个表的差(无容差):lst-lst1

留黄色的?

你把最大的边界保留修改就行了

点评

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

使用道具 举报

已领礼包: 199个

财富等级: 日进斗金

 楼主| 发表于 2020-8-6 16:35:53 | 显示全部楼层
newer 发表于 2020-8-6 15:57
图不全?

(xdrx-geom-searchregions (ssget '((0 . "line"))))

将表格线全部炸开后,用xdrx-geom-searchregions函数测试了下,
存在下列问题:
1、速度很慢
2、生成的图形如附图,不符合要求,不能使用。

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

使用道具 举报

已领礼包: 199个

财富等级: 日进斗金

 楼主| 发表于 2020-8-6 16:37:33 | 显示全部楼层
marting 发表于 2020-8-6 16:34
留黄色的?

你把最大的边界保留修改就行了

你测试下,不成立的。

点评

合理设置下精度 (xdrx-setvar "tolequalvector" 1.0) (xdrx-setvar "tolequalpoint" 1.0)  详情 回复 发表于 2020-8-6 17:19
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2020-8-6 17:19:49 | 显示全部楼层
dyjwyqz5221 发表于 2020-8-6 16:37
你测试下,不成立的。

合理设置下精度
(xdrx-setvar "tolequalvector" 1.0)
(xdrx-setvar "tolequalpoint" 1.0)

点评

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

使用道具 举报

已领礼包: 199个

财富等级: 日进斗金

 楼主| 发表于 2020-8-6 17:31:22 | 显示全部楼层
newer 发表于 2020-8-6 17:19
合理设置下精度
(xdrx-setvar "tolequalvector" 1.0)
(xdrx-setvar "tolequalpoint" 1.0)

哪个函数用到这两个参数?

点评

xdrx-geom-searchregions 用到 这个函数还用到 (xdrx-setvar "BoExtLen" 距离) , 曲线两侧延伸长度,就是可以有缝隙  详情 回复 发表于 2020-8-6 17:58
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2020-8-6 17:58:39 | 显示全部楼层
dyjwyqz5221 发表于 2020-8-6 17:31
哪个函数用到这两个参数?

xdrx-geom-searchregions 用到
这个函数还用到

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 20:59 , Processed in 0.288607 second(s), 63 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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