求助，有大神帮忙写一个延伸闭合线或者矩形的lsp吗？

bai2000

对，应该是9楼的效果才对

夏生生

试试

2. (vl-load-com)
   
3. (defun c:test (/    xty-get-dxf    xty-tr-ss2lst
   
4.          xty-tr-value2list     EN    LST     PARAM
   
5.          PT1    PT2       PT3  PT4     PTA
   
6.          PTB    PTC       SS    TEMP
   
7.         )
   
8.   (defun xty-get-dxf (code en) (cdr (assoc code (entget en))))
   
9.   (defun xty-tr-ss2lst (ss form / n en lst)
   
10.     (repeat (setq n (sslength ss))
    
11.       (setq en (ssname ss (setq n (1- n))))
    
12.       (setq lst (cons en lst))
    
13.     )
    
14.     (setq lst (reverse lst))
    
15.     (if  form
    
16.       lst
    
17.       (mapcar (function vlax-ename->vla-object) lst)
    
18.     )
    
19.   )
    
20.   (defun xty-tr-value2list (value)
    
21.     (setq value  (vl-catch-all-apply
    
22.       (function vlax-safearray->list)
    
23.       (list (vlax-variant-value value))
    
24.     )
    
25.     )
    
26.     (if  (= (type value) (function LIST))
    
27.       value
    
28.       nil
    
29.     )
    
30.   )
    
31.   (setq  pt1 (getpoint "\n栏选起点:")
    
32.   pt2 (getpoint pt1 "\n栏选终点:")
    
33.   ss  (ssget "f" (list pt1 pt2) '((0 . "lwpolyline")))
    
34.   lst (xty-tr-ss2lst ss nil)
    
35.   en  (vlax-ename->vla-object
    
36.         (ssname (ssget ":e:s" '((0 . "*line"))) 0)
    
37.       )
    
38.   pt3 (if  (= (vla-get-ObjectName en) "AcDbXline")
    
39.         (xty-tr-value2list(vla-get-basepoint en))
    
40.         (vlax-curve-getstartpoint en)
    
41.       )
    
42.   pt4 (if  (= (vla-get-ObjectName en) "AcDbXline")
    
43.         (xty-tr-value2list(vla-get-secondpoint en))
    
44.         (vlax-curve-getendpoint en)
    
45.       )
    
46.   )
    
47.   (foreach n lst
    
48.     (setq temp (xty-tr-value2list (vla-explode n)))
    
49.     (foreach m temp
    
50.       (setq pta  (xty-tr-value2list (vla-get-startpoint m))
    
51.       ptb  (xty-tr-value2list (vla-get-endpoint m))
    
52.       )
    
53.       (if (inters pt1 pt2 pta ptb)
    
54.   (progn (setq ptc   (inters pt3 pt4 pta ptb nil)
    
55.          pta   (if (< (distance ptc pta) (distance ptc ptb))
    
56.            pta
    
57.            ptb
    
58.          )
    
59.          param (fix (vlax-curve-getparamatpoint n pta))
    
60.          )
    
61.          (vla-put-coordinate
    
62.      n
    
63.      param
    
64.      (vlax-safearray-fill
    
65.        (vlax-make-safearray vlax-vbDouble '(0 . 1))
    
66.        (list (car ptc) (cadr ptc))
    
67.      )
    
68.          )
    
69.   )
    
70.       )
    
71.       (vla-delete m)
    
72.     )
    
73.   )
    
74. )

(vl-load-com)<br /> (defun c:test (/    xty-get-dxf    xty-tr-ss2lst<br />          xty-tr-value2list     EN    LST     PARAM<br />          PT1    PT2       PT3  PT4     PTA<br />          PTB    PTC       SS    TEMP<br />         )<br />   (defun xty-get-dxf (code en) (cdr (assoc code (entget en))))<br />   (defun xty-tr-ss2lst (ss form / n en lst)<br />     (repeat (setq n (sslength ss))<br />       (setq en (ssname ss (setq n (1- n))))<br />       (setq lst (cons en lst))<br />     )<br />     (setq lst (reverse lst))<br />     (if  form<br />       lst<br />       (mapcar (function vlax-ename->vla-object) lst)<br />     )<br />   )<br />   (defun xty-tr-value2list (value)<br />     (setq value  (vl-catch-all-apply<br />       (function vlax-safearray->list)<br />       (list (vlax-variant-value value))<br />     )<br />     )<br />     (if  (= (type value) (function LIST))<br />       value<br />       nil<br />     )<br />   )<br />   (setq  pt1 (getpoint "\n栏选起点:")<br />   pt2 (getpoint pt1 "\n栏选终点:")<br />   ss  (ssget "f" (list pt1 pt2) '((0 . "lwpolyline")))<br />   lst (xty-tr-ss2lst ss nil)<br />   en  (vlax-ename->vla-object<br />         (ssname (ssget ":e:s" '((0 . "*line"))) 0)<br />       )<br />   pt3 (if  (= (vla-get-ObjectName en) "AcDbXline")<br />         (xty-tr-value2list(vla-get-basepoint en))<br />         (vlax-curve-getstartpoint en)<br />       )<br />   pt4 (if  (= (vla-get-ObjectName en) "AcDbXline")<br />         (xty-tr-value2list(vla-get-secondpoint en))<br />         (vlax-curve-getendpoint en)<br />       )<br />   )<br />   (foreach n lst<br />     (setq temp (xty-tr-value2list (vla-explode n)))<br />     (foreach m temp<br />       (setq pta  (xty-tr-value2list (vla-get-startpoint m))<br />       ptb  (xty-tr-value2list (vla-get-endpoint m))<br />       )<br />       (if (inters pt1 pt2 pta ptb)<br />   (progn (setq ptc   (inters pt3 pt4 pta ptb nil)<br />          pta   (if (< (distance ptc pta) (distance ptc ptb))<br />            pta<br />            ptb<br />          )<br />          param (fix (vlax-curve-getparamatpoint n pta))<br />          )<br />          (vla-put-coordinate<br />      n<br />      param<br />      (vlax-safearray-fill<br />        (vlax-make-safearray vlax-vbDouble '(0 . 1))<br />        (list (car ptc) (cadr ptc))<br />      )<br />          )<br />   )<br />       )<br />       (vla-delete m)<br />     )<br />   )<br /> )

pizi158545086

夏生生 发表于 2021-12-13 20:22
试试

非常感谢帮忙，函数错误是什么回事呢，可以再帮忙下吗

夏生生

pizi158545086 发表于 2021-12-13 20:57
非常感谢帮忙，函数错误是什么回事呢，可以再帮忙下吗

告知我错误

夏生生

pizi158545086 发表于 2021-12-13 20:57
非常感谢帮忙，函数错误是什么回事呢，可以再帮忙下吗

疏忽了*xty-e2o*改成vlax-ename->vla-object

pizi158545086

夏生生 发表于 2021-12-13 21:29
疏忽了*xty-e2o*改成vlax-ename->vla-object

没看到*xty-e2o*这段文字，尴尬，可以发下完整源码吗？谢谢

夏生生

pizi158545086 发表于 2021-12-13 21:38
没看到*xty-e2o*这段文字，尴尬，可以发下完整源码吗？谢谢

在12楼改了

xj6019

夏生生 发表于 2021-12-13 20:22
试试

真是高手  ！！厉害！！佩服！！

pizi158545086

夏生生 发表于 2021-12-13 23:02
在12楼改了

不知道怎么回事  加载了  命令行显示栏选起点 ，下一步就显示错误了  难道是我CAD版本的原因？我用的版本是2021

xj6019

pizi158545086 发表于 2021-12-14 08:58
不知道怎么回事  加载了  命令行显示栏选起点 ，下一步就显示错误了  难道是我CAD版本的原因？我用的版本 ...

哥们你选的时候 两点穿过你的矩形