请问多个坐标点连线的简化代码如何写？谢谢~

逗亦斗霸

2. (defun c:tt (/ pt)
   
3.     (setq p0 (getpoint "\n插入点: ") )
   
4.     (setq p1 (mapcar '+ p0 '(0 10 0) ) )
   
5.     (setq p2 (mapcar '+ p0 '(5 20 0) ) )
   
6.     (setq p3 (mapcar '+ p0 '(40 40 0) ) )
   
7.     (setq p4 (mapcar '+ p0 '(80 80 0) ) )
   
8.     (setq p5 (mapcar '+ p0 '(150 90 0) ) )
   
9.     (setq p6 (mapcar '+ p0 '(300 120 0) ) )
   
10.   
    
11.   (setq lst (list p1 p2) )
    
12.   (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(8 . "0") '(62 . 0) (cons 90 (length lst) ) '(70 . 1) )
    
13.              (mapcar '(lambda (pt) (cons 10 pt) ) lst) ) )
    
14.   
    
15.   (setq lst (list p3 p4) )
    
16.   (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(8 . "0") '(62 . 0) (cons 90 (length lst) ) '(70 . 1) )
    
17.              (mapcar '(lambda (pt) (cons 10 pt) ) lst) ) )
    
18.   
    
19.   (setq lst (list p1 p5) )
    
20.   (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(8 . "0") '(62 . 0) (cons 90 (length lst) ) '(70 . 1) )
    
21.              (mapcar '(lambda (pt) (cons 10 pt) ) lst) ) )
    
22. )

(defun c:tt (/ pt)<br />     (setq p0 (getpoint "\n插入点: ") )<br />     (setq p1 (mapcar '+ p0 '(0 10 0) ) )<br />     (setq p2 (mapcar '+ p0 '(5 20 0) ) )<br />     (setq p3 (mapcar '+ p0 '(40 40 0) ) )<br />     (setq p4 (mapcar '+ p0 '(80 80 0) ) )<br />     (setq p5 (mapcar '+ p0 '(150 90 0) ) )<br />     (setq p6 (mapcar '+ p0 '(300 120 0) ) )<br />   <br />   (setq lst (list p1 p2) )<br />   (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(8 . "0") '(62 . 0) (cons 90 (length lst) ) '(70 . 1) )<br />              (mapcar '(lambda (pt) (cons 10 pt) ) lst) ) )<br />   <br />   (setq lst (list p3 p4) )<br />   (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(8 . "0") '(62 . 0) (cons 90 (length lst) ) '(70 . 1) )<br />              (mapcar '(lambda (pt) (cons 10 pt) ) lst) ) )<br />   <br />   (setq lst (list p1 p5) )<br />   (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(8 . "0") '(62 . 0) (cons 90 (length lst) ) '(70 . 1) )<br />              (mapcar '(lambda (pt) (cons 10 pt) ) lst) ) )<br /> )

p1~p6为无规律的坐标点，需要两两连线，用以上代码的方式写下来的话会很冗长，求精简的写法，谢谢~

llsheng_73

1. (defun c:tt(/ p0 p1 p2 p3 p4 p5 p6)
   
2.   (setq p0(cons 10(getpoint "\n插入点: ")))
   
3.   (setq p1(mapcar '+ p0 '(0 0 10 0) )
   
4.         p2(mapcar '+ p0 '(0 5 20 0) )
   
5.         p3(mapcar '+ p0 '(0 40 40 0) )
   
6.         p4(mapcar '+ p0 '(0 80 80 0) )
   
7.         p5(mapcar '+ p0 '(0 150 90 0) )
   
8.         p6(mapcar '+ p0 '(0 300 120 0) ))
   
9.   (vl-every(function(lambda(x)
   
10.                       (entmakex(append'((0 . "LWPOLYLINE")(100 . "AcDbEntity")(100 . "AcDbPolyline")(90 . 2)(70 . 0))x))))
    
11.            (list(list p1 p2)
    
12.                 (list p3 p4)
    
13.                 (list p1 p5))
    
14.            )
    
15.   )

(defun c:tt(/ p0 p1 p2 p3 p4 p5 p6)<br />   (setq p0(cons 10(getpoint "\n插入点: ")))<br />   (setq p1(mapcar '+ p0 '(0 0 10 0) )<br />         p2(mapcar '+ p0 '(0 5 20 0) )<br />         p3(mapcar '+ p0 '(0 40 40 0) )<br />         p4(mapcar '+ p0 '(0 80 80 0) )<br />         p5(mapcar '+ p0 '(0 150 90 0) )<br />         p6(mapcar '+ p0 '(0 300 120 0) ))<br />   (vl-every(function(lambda(x)<br />                       (entmakex(append'((0 . "LWPOLYLINE")(100 . "AcDbEntity")(100 . "AcDbPolyline")(90 . 2)(70 . 0))x))))<br />            (list(list p1 p2)<br />                 (list p3 p4)<br />                 (list p1 p5))<br />            )<br />   )

被承包的东子

(defun c:tt1 (/ entmake-pl lst p0 p1 p2 p3 p4 p5 p6 pt)
    (setq p0 (getpoint "\n插入点: ") )
    (setq p1 (mapcar '+ p0 '(0 10 0) ) )
    (setq p2 (mapcar '+ p0 '(5 20 0) ) )
    (setq p3 (mapcar '+ p0 '(40 40 0) ) )
    (setq p4 (mapcar '+ p0 '(80 80 0) ) )
    (setq p5 (mapcar '+ p0 '(150 90 0) ) )
    (setq p6 (mapcar '+ p0 '(300 120 0) ) )
  (defun entmake-pl(lst)
                (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(8 . "0") '(62 . 0) (cons 90 (length lst) ) '(70 . 1) )
             (mapcar '(lambda (pt) (cons 10 pt) ) lst) ) )
        )
  (setq lst (list (list p1 p2)(list p3 p4)(list p1 p5)) )
(mapcar 'entmake-pl lst )
  (PRINC)
)

wwwswallow

重复的代码可以用自定义函数代替。

逗亦斗霸

wwwswallow 发表于 2024-11-27 11:49
重复的代码可以用自定义函数代替。

是的，就是不知道怎么自定义，因为没有规律，也不能用repeat函数代替~

逗亦斗霸

被承包的东子 发表于 2024-11-27 11:46
(defun c:tt1 (/ entmake-pl lst p0 p1 p2 p3 p4 p5 p6 pt)
    (setq p0 (getpoint "\n插入点: ") )
    ...

谢谢啦~

xyp1964

1. (defun c:tt ()
   
2.   (defun abc (lst c)
   
3.     (entmakex (append (list '(0 . "LWPOLYLINE")
   
4.                             '(100 . "AcDbEntity")
   
5.                             '(100 . "AcDbPolyline")
   
6.                             (cons 90 (length lst))
   
7.                             (if c '(70 . 1) '(70 . 0))
   
8.                       )
   
9.                       (mapcar '(lambda (x) (cons 10 x)) lst)
   
10.               )
    
11.     )
    
12.   )
    
13.   (setq p0 (getpoint "\n插入点: "))
    
14.   (setq p1 (mapcar '+ p0 '(0 10)))
    
15.   (setq p2 (mapcar '+ p0 '(5 20)))
    
16.   (setq p3 (mapcar '+ p0 '(40 40)))
    
17.   (setq p4 (mapcar '+ p0 '(80 80)))
    
18.   (setq p5 (mapcar '+ p0 '(150 90)))
    
19.   (setq p6 (mapcar '+ p0 '(300 120)))
    
20.   (abc (list p1 p2) nil)
    
21.   (abc (list p3 p4) nil)
    
22.   (abc (list p1 p5) nil)
    
23.   (princ)
    
24. )

(defun c:tt ()<br />   (defun abc (lst c)<br />     (entmakex (append (list '(0 . "LWPOLYLINE")<br />                             '(100 . "AcDbEntity")<br />                             '(100 . "AcDbPolyline")<br />                             (cons 90 (length lst))<br />                             (if c '(70 . 1) '(70 . 0))<br />                       )<br />                       (mapcar '(lambda (x) (cons 10 x)) lst)<br />               )<br />     )<br />   )<br />   (setq p0 (getpoint "\n插入点: "))<br />   (setq p1 (mapcar '+ p0 '(0 10)))<br />   (setq p2 (mapcar '+ p0 '(5 20)))<br />   (setq p3 (mapcar '+ p0 '(40 40)))<br />   (setq p4 (mapcar '+ p0 '(80 80)))<br />   (setq p5 (mapcar '+ p0 '(150 90)))<br />   (setq p6 (mapcar '+ p0 '(300 120)))<br />   (abc (list p1 p2) nil)<br />   (abc (list p3 p4) nil)<br />   (abc (list p1 p5) nil)<br />   (princ)<br /> )

逗亦斗霸

xyp1964 发表于 2024-11-27 13:11

感谢版主指点，又学会了另一个写法~

逗亦斗霸

llsheng_73 发表于 2024-11-27 16:11

第二行这个写法给了我新的启发，感谢感谢~