【S】填充拉伸_V7.4---替代CAD原拉伸命令！

kucha007

很好用的拉伸工具，也来接力~。原帖在这里：http://bbs.mjtd.com/forum.php?mod=viewthread&tid=181607&page=15&extra=#pid928859
因改动较大，且原帖楼层太多了，所以另开一个帖子，方便各位朋友下载。


如果大家有在这个基础上改动，也请发出来互相学习。后续有问题或者更新我也在这里发布。

两个有意思的函数：

1. ;收集给定实体之后产生的所有实体
   
2. (defun K:NewSS_After (elast / en SS)
   
3.   (if elast
   
4.     (progn
   
5.       (setq SS (ssadd))
   
6.       (setq en (entnext elast))
   
7.       (while en
   
8.         (if
   
9.           (not (member (cdr (assoc 0 (entget en))) '("ATTRIB" "VERTEX" "SEQEND")))
   
10.           (setq SS (ssadd en SS))
    
11.         )
    
12.         (setq en (entnext en))
    
13.       )
    
14.       SS
    
15.     )
    
16.   )
    
17. )
    
18. [code=lisp]
    
19. ;获取框选对象时的选择集UCS选框坐标(右上和左下,忽略Z值)
    
20. (defun K:GetSSUCSBox (SS / OriLst x xx)
    
21.   (mapcar
    
22.     '(lambda (xx)
    
23.       (setq OriLst
    
24.               (mapcar
    
25.                 '(lambda (xx)
    
26.                   (trans
    
27.                     (list  (car (cadr xx)) (cadr (cadr xx))  0.0)
    
28.                     0 1
    
29.                   )
    
30.                 )
    
31.                 (cdr xx)
    
32.               )
    
33.       );UCS
    
34.       (list
    
35.         (apply 'mapcar (cons 'max OriLst))
    
36.         (apply 'mapcar (cons 'min OriLst))
    
37.       );取右上和左下
    
38.     )
    
39.     (vl-remove-if-not
    
40.       '(lambda(x) (< (car x) 0))
    
41.         (ssnamex SS)
    
42.     )
    
43.   )
    
44. )
    

;收集给定实体之后产生的所有实体<br /> (defun K:NewSS_After (elast / en SS) <br />   (if elast <br />     (progn <br />       (setq SS (ssadd))<br />       (setq en (entnext elast))<br />       (while en <br />         (if <br />           (not (member (cdr (assoc 0 (entget en))) '("ATTRIB" "VERTEX" "SEQEND")))<br />           (setq SS (ssadd en SS))<br />         )<br />         (setq en (entnext en))<br />       )<br />       SS<br />     )<br />   )<br /> )<br /> [code=lisp]<br /> ;获取框选对象时的选择集UCS选框坐标(右上和左下,忽略Z值)<br /> (defun K:GetSSUCSBox (SS / OriLst x xx)<br />   (mapcar <br />     '(lambda (xx) <br />       (setq OriLst <br />               (mapcar <br />                 '(lambda (xx)<br />                   (trans <br />                     (list  (car (cadr xx)) (cadr (cadr xx))  0.0)<br />                     0 1<br />                   )<br />                 )<br />                 (cdr xx)<br />               )<br />       );UCS<br />       (list<br />         (apply 'mapcar (cons 'max OriLst))<br />         (apply 'mapcar (cons 'min OriLst))<br />       );取右上和左下<br />     )<br />     (vl-remove-if-not <br />       '(lambda(x) (< (car x) 0))<br />         (ssnamex SS)<br />     )<br />   )<br /> )<br />

kucha007

2023备用楼

20230717_v7.4
1-修复外部参照拉伸出错



20230705_v7.2
1-重构改写程序，加了不少注释。变量名称也更易懂，方便大家后续改写。
2-修复UCS下会拉伸错误的情况。
3-拉伸框忽略Z值。

langhint

优秀，原来的最近使用不了，看看这个！

ljfzx

xj6019 发表于 2022-10-14 20:56
我试了一下 ctrl+z还是不行  这难道是个不治之症吗，之前其他情况也研究过  没搞定
不过现在的版本，边界 ...

2020测试 ctrl+z不行，但是原贴原版没有这个问题

15日上午的新版本已经修复了

lxl217114

为钻研精神点赞

xj6019

我试了一下 ctrl+z还是不行  这难道是个不治之症吗，之前其他情况也研究过  没搞定
不过现在的版本，边界线已经不会回来了，图层不行  图层会回来

kucha007

xj6019 发表于 2022-10-14 20:56
我试了一下 ctrl+z还是不行  这难道是个不治之症吗，之前其他情况也研究过  没搞定
不过现在的版本，边界 ...

我在CAD2014上按你说的步骤测试了没问题啊。你的CAD版本是多少啊？

czb203

为钻研精神点赞

lxl217114

kucha007 发表于 2022-10-14 22:19
我在CAD2014上按你说的步骤测试了没问题啊。你的CAD版本是多少啊？

同xj6019大佬
2023版本

ljfzx

有个问题 一直都有 就是如果有文字或者标注在填充边界的时候，填充考虑孤岛避让。拉伸填充的时候，填充会溢出边界。

kucha007

lxl217114 发表于 2022-10-14 23:13
同xj6019大佬
2023版本

我用2018测试了一下确实会有这个问题。已经修复了，麻烦您再看一下

kucha007

ljfzx 发表于 2022-10-15 09:17
有个问题 一直都有 就是如果有文字或者标注在填充边界的时候，填充考虑孤岛避让。拉伸填充的时候，填充会溢 ...

这个插件拉伸时会生成边界，拉伸后再删除就会解除填充关联。正常在CAD中解除关联再拉伸也会这样，我也不知道咋改，期待后面有大佬来解疑吧。