重生成多段线表格线框（使用于结构专业）

dyjwyqz5221

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

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

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

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

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

[mw_shl_code=actionscript3,true](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[/mw_shl_code]

dyjwyqz5221

XD::Layer:Get1函数是自己函数XD::Layer:Get基础上修改的一个函数，可以进行过滤选择了，此处可以采用XD::Layer:Get

dyjwyqz5221

命令: get-tab
拾取“详图表格框”确定图层<返回>:
拾取“详图表格框”确定图层<返回>:
拾取“详图表格框”确定图层<返回>:
框选详图表格线框<退出>:指定对角点: 找到 118 个
框选详图表格线框<退出>:
恭喜：共生成 73 个闭合多段线表格线框。
执行时间:0.136s.
框选详图表格线框<退出>:

dyjwyqz5221

欢迎测试，有问题请告诉我！

dyjwyqz5221

(**error-set**)是我自己写的一个错误处理函数，未添加，可以去掉。其余函数基本都是用的api函数、lsp函数了

dyjwyqz5221

本程序中，函数get::pts为获取哪些表格线是连接在一起的，对其他程序也是适用的。里面又好多内容可以借鉴。

newer

图不全？

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

这行，就把表格做出来了

dyjwyqz5221

newer 发表于 2020-8-6 15:57
图不全？

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

我看下测试图，

dyjwyqz5221

newer 发表于 2020-8-6 15:57
图不全？

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

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

marting

dyjwyqz5221 发表于 2020-8-6 16:19
是测试图cad上传错了，已经修改过来了。
另外附加函数
;;;两个表的差(无容差)：lst-lst1

留黄色的？

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

dyjwyqz5221

newer 发表于 2020-8-6 15:57
图不全？

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

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

dyjwyqz5221

marting 发表于 2020-8-6 16:34
留黄色的？

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

你测试下，不成立的。

newer

dyjwyqz5221 发表于 2020-8-6 16:37
你测试下，不成立的。

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

dyjwyqz5221

newer 发表于 2020-8-6 17:19
合理设置下精度
(xdrx-setvar "tolequalvector" 1.0)
(xdrx-setvar "tolequalpoint" 1.0)

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

newer

dyjwyqz5221 发表于 2020-8-6 17:31
哪个函数用到这两个参数？

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

(xdrx-setvar "BoExtLen" 距离) , 曲线两侧延伸长度，就是可以有缝隙