- UID
- 773205
- 积分
- 1143
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2017-12-26
- 最后登录
- 1970-1-1
|
- 插件名称 ： 表格线框
- 作 者 ： dyjwyaz5221
- 运行环境 ：XDRX API
- 发布时间 ：2020-08-06
- 命令名称 ：get-tab
- 插件介绍 ：适用于结构专业框架柱、剪力墙边缘构件表格
- 备 注 ： (点击图片可以放大)
插件详细内容
马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。
您需要 登录 才可以下载或查看，没有账号？立即注册
x
本帖最后由 dyjwyqz5221 于 2020-8-6 16:50 编辑
;;;使用最新的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] |
-
-
-
测试图_t3.rar
186.9 KB, 下载次数: 10, 下载积分: D豆 -1 , 活跃度 1
|
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
窥视卡
雷达卡
已领礼包: 
财富等级: 
发表于 2020-8-6 11:35:54
提升卡
置顶卡
沉默卡
变色卡
千斤顶
楼主
发表于 2020-8-6 15:57:32
