（求助）请教一下各位大神，多边矩形两端延长缩短如何实现？
请教一下各位大神，论坛里搜索中貌似没有相似的功能（多边矩形两端延长缩短）所以想求助一下各位大神，这种的看有没有大神可以帮忙实现呢？颜色随原图层
输入的数值带记忆功能
谢谢各位大神
拉伸........ wzg356 发表于 2022-7-6 19:20
拉伸........
大神早上好，拉伸就是一个个拉伸，我是想能不能实现批量的两端拉伸呢
炸开延长两端较长的那两根线然后移动短的封口线 不就可以了 应该没多大难度 试试，子函数不一定拷贝全了，undo、记忆、错误处理都是基操，自己解决
;;;适用于autocad2011以上版本,改了系统变量，管杀不管埋
(defun c:test (/ dis en1 en2 lst lst1 pt1 pt2 pt3 pt4 ss tmp)
(setvar 'peditaccept 1)
(setqdis (getreal "\n输入尺寸:")
ss(ssget '((0 . "lwpolyline")))
lst (xty-tr-ss2lst ss t)
)
(foreach n lst
(setq tmp (entlast))
(command "explode" n)
(setq ss (xty-get-adden tmp 1)
lst1 (xty-tr-ss2lst ss t)
lst1 (vl-sortlst1
'(lambda (a b)
(< (getpropertyvalue a "length")
(getpropertyvalue b "length")
)
)
)
en1(car lst1)
pt1(vlax-curve-getstartpoint en1)
pt2(vlax-curve-getendpoint en1)
en2(cadr lst1)
pt3(vlax-curve-getstartpoint en2)
pt4(vlax-curve-getendpoint en2)
lst1 (cddr lst1)
)
(foreach m lst1
(cond ((equal pt1 (vlax-curve-getstartpoint m) 1e-6)
(command "lengthen" "de" dis (list m pt1) "")
(setpropertyvalue
en1
"startpoint"
(vlax-curve-getstartpoint m)
)
)
((equal pt1 (vlax-curve-getendpoint m) 1e-6)
(command "lengthen" "de" dis (list m pt1) "")
(setpropertyvalue
en1
"startpoint"
(vlax-curve-getendpoint m)
)
)
((equal pt2 (vlax-curve-getstartpoint m) 1e-6)
(command "lengthen" "de" dis (list m pt2) "")
(setpropertyvalue
en1
"endpoint"
(vlax-curve-getstartpoint m)
)
)
((equal pt2 (vlax-curve-getendpoint m) 1e-6)
(command "lengthen" "de" dis (list m pt2) "")
(setpropertyvalue
en1
"endpoint"
(vlax-curve-getendpoint m)
)
)
)
(cond ((equal pt3 (vlax-curve-getstartpoint m) 1e-6)
(command "lengthen" "de" dis (list m pt3) "")
(setpropertyvalue
en2
"startpoint"
(vlax-curve-getstartpoint m)
)
)
((equal pt3 (vlax-curve-getendpoint m) 1e-6)
(command "lengthen" "de" dis (list m pt3) "")
(setpropertyvalue
en2
"startpoint"
(vlax-curve-getendpoint m)
)
)
((equal pt4 (vlax-curve-getstartpoint m) 1e-6)
(command "lengthen" "de" dis (list m pt4) "")
(setpropertyvalue
en2
"endpoint"
(vlax-curve-getstartpoint m)
)
)
((equal pt4 (vlax-curve-getendpoint m) 1e-6)
(command "lengthen" "de" dis (list m pt4) "")
(setpropertyvalue
en2
"endpoint"
(vlax-curve-getendpoint m)
)
)
)
)
(command"pedit" "m"ss "" "j" "0""")
)
)
(defun xty-tr-ss2lst (ss form / n en lst)
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq lst (cons en lst))
)
(setq lst (reverse lst))
(if form
lst
(mapcar (function vlax-ename->vla-object) lst)
)
)
(defun xty-get-adden (lasten mode / lst ss)
(while (setq lasten (entnext lasten))
(setq lst (cons lasten lst))
)
(cond((= 0 mode) (setq ss (reverse lst)))
((= 1 mode)
(setq ss (ssadd))
(foreach n lst (setq ss (ssadd n ss)))
)
)
ss
)
夏生生 发表于 2022-7-7 16:12
试试，子函数不一定拷贝全了，undo、记忆、错误处理都是基操，自己解决
大神您好，感谢您的帮助，我这边用2019运行显示 未知命令，用2007运行显示 语法错误呢 guosheyang 发表于 2022-7-7 09:10
炸开延长两端较长的那两根线然后移动短的封口线 不就可以了 应该没多大难度
我想像中是没有难道，就是代码的组合逻辑关系，还不懂呢 999999 发表于 2022-7-7 18:24
我想像中是没有难道，就是代码的组合逻辑关系，还不懂呢
函数有2011版以后新增函数，至于2019用不了我也不知是何缘由，实在不行你看思路吧。 999999 发表于 2022-7-7 18:24
我想像中是没有难道，就是代码的组合逻辑关系，还不懂呢
就是炸开，排序，按您例图，最短的两个边是延伸边，找出与短边端点共点的长边，lengthen命令，再更新短边端点为长边延伸后端点，最后pedit ;弧形的麻烦
页:
[1]
2