（求助）请教一下各位大神，多边矩形两端延长缩短如何实现？

999999 · 发表于 2022-7-6 11:59:13

请教一下各位大神，论坛里搜索中貌似没有相似的功能（多边矩形两端延长缩短）所以想求助一下各位大神，这种的看有没有大神可以帮忙实现呢？

颜色随原图层
输入的数值带记忆功能

谢谢各位大神

wzg356 · 发表于 2022-7-6 19:20:36

拉伸........

999999 · 发表于 2022-7-7 09:04:37

wzg356 发表于 2022-7-6 19:20
拉伸........

大神早上好，拉伸就是一个个拉伸，我是想能不能实现批量的两端拉伸呢

guosheyang · 发表于 2022-7-7 09:10:09

炸开延长两端较长的那两根线然后移动短的封口线不就可以了应该没多大难度

夏生生 · 发表于 2022-7-7 16:12:23

试试，子函数不一定拷贝全了，undo、记忆、错误处理都是基操，自己解决

;;;适用于autocad2011以上版本,改了系统变量，管杀不管埋
(defun c:test (/ dis en1 en2 lst lst1 pt1 pt2 pt3 pt4 ss tmp)
(setvar 'peditaccept 1)
(setq dis (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-sort lst1
'(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
)

;;;适用于autocad2011以上版本,改了系统变量，管杀不管埋 
(defun c:test (/ dis en1 en2 lst lst1 pt1 pt2 pt3 pt4 ss tmp) 
  (setvar 'peditaccept 1) 
  (setq  dis (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-sort  lst1 
      '(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 
  )

999999 · 发表于 2022-7-7 18:23:25

夏生生发表于 2022-7-7 16:12
试试，子函数不一定拷贝全了，undo、记忆、错误处理都是基操，自己解决

大神您好，感谢您的帮助，我这边用2019运行显示未知命令，用2007运行显示语法错误呢

999999 · 发表于 2022-7-7 18:24:30

guosheyang 发表于 2022-7-7 09:10
炸开延长两端较长的那两根线然后移动短的封口线不就可以了应该没多大难度

我想像中是没有难道，就是代码的组合逻辑关系，还不懂呢

夏生生 · 发表于 2022-7-7 19:26:48

999999 发表于 2022-7-7 18:24
我想像中是没有难道，就是代码的组合逻辑关系，还不懂呢

函数有2011版以后新增函数，至于2019用不了我也不知是何缘由，实在不行你看思路吧。

夏生生 · 发表于 2022-7-7 19:32:48

999999 发表于 2022-7-7 18:24
我想像中是没有难道，就是代码的组合逻辑关系，还不懂呢

就是炸开，排序，按您例图，最短的两个边是延伸边，找出与短边端点共点的长边，lengthen命令，再更新短边端点为长边延伸后端点，最后pedit

xyp1964 · 发表于 2022-7-7 21:52:27

;弧形的麻烦

账号		自动登录	找回密码
密码			注册

[提问] （求助）请教一下各位大神，多边矩形两端延长缩短如何实现？

本帖子中包含更多资源

本帖子中包含更多资源

浏览过的版块