请问大家快速选择首尾相连的所有线段，如何用lisp实现啊

edata

没办法。你看gu_xl版主的这个吧。
http://bbs.mjtd.com/forum.php?mo ... &fromuid=338795

2. ;;选择直线相连 By Gu_xl
   
3. (defun c:tt(/ gxl-Sel-ReDrawSel gxl-Sel-SSsub gxl-Sel-SSJoin gxl-sel-SSgetLineatPoint getline)
   
4.   (defun gxl-Sel-ReDrawSel (Sel mode / m n)
   
5.     (setq m (sslength Sel)
   
6.    n 0)
   
7.     (repeat m
   
8. (redraw (ssname Sel n) mode)
   
9. (setq n (1+ n))
   
10. );repeat
    
11.     )
    
12.   (defun gxl-Sel-SSsub(ss1 ss2 / ss n)
    
13. (cond
    
14. ((and ss1 ss2)
    
15.   (setq n 0)
    
16.   (repeat (sslength ss2)
    
17.     (ssdel (ssname ss2 n) ss1)
    
18.     (setq n (1+ n))
    
19.     )
    
20. )
    
21. ((and ss1 (not ss2))
    
22.   ss1
    
23. )
    
24. (T
    
25.   (setq ss1 nil)
    
26. )
    
27. )
    
28. ss1
    
29. )
    
30.   (defun gxl-Sel-SSJoin ( ss1 ss2 / ename ss cnt )
    
31. (if ss1
    
32. (progn
    
33. (if (= (type ss1) 'ENAME)
    
34. (progn
    
35.   (setq
    
36.    ename ss1
    
37.    ss1   (ssadd)
    
38.   )
    
39.   (ssadd ename ss1)
    
40. ))
    
41. ))
    
42. (if ss2
    
43. (progn
    
44. (if (= (type ss2) 'ENAME)
    
45. (progn
    
46.   (setq
    
47.    ename ss2
    
48.    ss2   (ssadd)
    
49.   )
    
50.   (ssadd ename ss2)
    
51. ))
    
52. ))
    
53. (setq ss (ssadd))
    
54. (if (and ss1 ss2)
    
55. (progn
    
56. ;(setq ss ss2 cnt 0)
    
57.         (setq  cnt 0)
    
58.         (repeat (sslength ss2)
    
59.   (ssadd (ssname ss2 cnt) ss)
    
60.   (setq cnt (1+ cnt))
    
61. )
    
62.         (setq  cnt 0)
    
63. (repeat (sslength ss1)
    
64.   (ssadd (ssname ss1 cnt) ss)
    
65.   (setq cnt (1+ cnt))
    
66. )
    
67. ))
    
68. (if (and ss1 (not ss2))
    
69. (setq ss ss1))
    
70. (if (and ss2 (not ss1))
    
71. (setq ss ss2))
    
72. (if (> (sslength ss) 0)
    
73.   ;;(eval ss)
    
74. ss
    
75. nil
    
76. )
    
77. )
    
78.   (defun gxl-sel-SSgetLineatPoint (pt jd /  px py px0 px1 py0 py1 ss  pz)
    
79. (setq px (car pt)
    
80.       px0 (- px jd)
    
81.       px1 (+ px jd)
    
82.       py (cadr pt)
    
83.       py0 (- py jd)
    
84.       py1 (+ py jd)
    
85.       pz (caddr pt)
    
86.       )
    
87.   (setq ss
    
88. (ssget "x" (list '(0 . "line")
    
89.    '(-4 . "<or")
    
90. 
    
91.    '(-4 . "<and")
    
92.    '(-4 . ">=,>=,=")
    
93.    (list 10 px0 py0 pz)
    
94.    '(-4 . "<=,<=,=")
    
95.    (list 10 px1 py1 pz)
    
96.    '(-4 . "and>")
    
97.    
    
98.    '(-4 . "<and")
    
99.    '(-4 . ">=,>=,=")
    
100.    (list 11 px0 py0 pz)
     
101.    '(-4 . "<=,<=,=")
     
102.    (list 11 px1 py1 pz)
     
103.    '(-4 . "and>")
     
104.    
     
105.    '(-4 . "or>")
     
106.    )
     
107.        )
     
108.   )
     
109.   (if ss(GXL-SEL-REDRAWSEL ss 3))
     
110.   ss
     
111.   )
     
112.   (defun getline (pt jd / s s1 n p1 p2)
     
113.    
     
114.     (setq s (gxl-sel-SSgetLineatPoint pt jd))
     
115.     (if s
     
116.       (progn
     
117. (setq s1 (GXL-SEL-SSSUB s ssrtl)
     
118.        ssrtl (GXL-SEL-SSJOIN ssrtl s1)
     
119.        )
     
120. 
     
121. (if s1
     
122.    (progn
     
123.      (setq n 0)
     
124.      (repeat (sslength s1)
     
125.        (setq p1 (cdr (assoc 10 (entget (ssname s1 n))))
     
126.       p2 (cdr (assoc 11 (entget (ssname s1 n))))
     
127.       )
     
128.        (getline p2 jd)
     
129.        (getline p1 jd)
     
130.        (setq n (1+ n))
     
131.        )
     
132.      )
     
133.    )
     
134. )
     
135.       )
     
136.    
     
137.     )
     
138.   ;;;程序开始
     
139.     (princ "\n选择直线：")
     
140.   (setq enline (car (entsel)))
     
141.   (initget 5 "  ")
     
142.   (setq jd (getreal "输入容差精度：<0.001>"))
     
143.   (if (= jd "")(setq jd 0.001))
     
144.   (setq pt1 (cdr (assoc 10 (entget enline))))
     
145.   (setq pt2 (cdr (assoc 11 (entget enline))))
     
146. (setq ssrtl (ssadd enline))
     
147.   (getline pt1 jd)
     
148.   (getline pt2 jd)
     
149.   (sssetfirst nil ssrtl)
     
150.   )
     

;;选择直线相连 By Gu_xl<br /> (defun c:tt(/ gxl-Sel-ReDrawSel gxl-Sel-SSsub gxl-Sel-SSJoin gxl-sel-SSgetLineatPoint getline)<br />   (defun gxl-Sel-ReDrawSel (Sel mode / m n)<br />     (setq m (sslength Sel)<br />    n 0)<br />     (repeat m<br /> (redraw (ssname Sel n) mode)<br /> (setq n (1+ n))<br /> );repeat<br />     )<br />   (defun gxl-Sel-SSsub(ss1 ss2 / ss n)<br /> (cond<br /> ((and ss1 ss2)<br />   (setq n 0)<br />   (repeat (sslength ss2)<br />     (ssdel (ssname ss2 n) ss1)<br />     (setq n (1+ n))<br />     )<br /> )<br /> ((and ss1 (not ss2))<br />   ss1<br /> )<br /> (T<br />   (setq ss1 nil)<br /> )<br /> )<br /> ss1<br /> )<br />   (defun gxl-Sel-SSJoin ( ss1 ss2 / ename ss cnt )<br /> (if ss1<br /> (progn<br /> (if (= (type ss1) 'ENAME)<br /> (progn<br />   (setq<br />    ename ss1<br />    ss1   (ssadd)<br />   )<br />   (ssadd ename ss1)<br /> ))<br /> ))<br /> (if ss2<br /> (progn<br /> (if (= (type ss2) 'ENAME)<br /> (progn<br />   (setq<br />    ename ss2<br />    ss2   (ssadd)<br />   )<br />   (ssadd ename ss2)<br /> ))<br /> ))<br /> (setq ss (ssadd))<br /> (if (and ss1 ss2)<br /> (progn<br /> ;(setq ss ss2 cnt 0)<br />         (setq  cnt 0)<br />         (repeat (sslength ss2)<br />   (ssadd (ssname ss2 cnt) ss)<br />   (setq cnt (1+ cnt))<br /> )<br />         (setq  cnt 0)<br /> (repeat (sslength ss1)<br />   (ssadd (ssname ss1 cnt) ss)<br />   (setq cnt (1+ cnt))<br /> )<br /> ))<br /> (if (and ss1 (not ss2))<br /> (setq ss ss1))<br /> (if (and ss2 (not ss1))<br /> (setq ss ss2))<br /> (if (> (sslength ss) 0)<br />   ;;(eval ss)<br /> ss<br /> nil<br /> )<br /> )<br />   (defun gxl-sel-SSgetLineatPoint (pt jd /  px py px0 px1 py0 py1 ss  pz)<br /> (setq px (car pt)<br />       px0 (- px jd)<br />       px1 (+ px jd)<br />       py (cadr pt)<br />       py0 (- py jd)<br />       py1 (+ py jd)<br />       pz (caddr pt)<br />       )<br />   (setq ss<br /> (ssget "x" (list '(0 . "line")<br />    '(-4 . "<or")<br /> <br />    '(-4 . "<and")<br />    '(-4 . ">=,>=,=")<br />    (list 10 px0 py0 pz)<br />    '(-4 . "<=,<=,=")<br />    (list 10 px1 py1 pz)<br />    '(-4 . "and>")<br />    <br />    '(-4 . "<and")<br />    '(-4 . ">=,>=,=")<br />    (list 11 px0 py0 pz)<br />    '(-4 . "<=,<=,=")<br />    (list 11 px1 py1 pz)<br />    '(-4 . "and>")<br />    <br />    '(-4 . "or>")<br />    )<br />        )<br />   )<br />   (if ss(GXL-SEL-REDRAWSEL ss 3))<br />   ss<br />   )<br />   (defun getline (pt jd / s s1 n p1 p2)<br />     <br />     (setq s (gxl-sel-SSgetLineatPoint pt jd))<br />     (if s<br />       (progn<br /> (setq s1 (GXL-SEL-SSSUB s ssrtl)<br />        ssrtl (GXL-SEL-SSJOIN ssrtl s1)<br />        )<br /> <br /> (if s1<br />    (progn<br />      (setq n 0)<br />      (repeat (sslength s1)<br />        (setq p1 (cdr (assoc 10 (entget (ssname s1 n))))<br />       p2 (cdr (assoc 11 (entget (ssname s1 n))))<br />       )<br />        (getline p2 jd)<br />        (getline p1 jd)<br />        (setq n (1+ n))<br />        )<br />      )<br />    )<br /> )<br />       )<br />     <br />     )<br />   ;;;程序开始<br />     (princ "\n选择直线：")<br />   (setq enline (car (entsel)))<br />   (initget 5 "  ")<br />   (setq jd (getreal "输入容差精度：<0.001>"))<br />   (if (= jd "")(setq jd 0.001))<br />   (setq pt1 (cdr (assoc 10 (entget enline))))<br />   (setq pt2 (cdr (assoc 11 (entget enline))))<br /> (setq ssrtl (ssadd enline))<br />   (getline pt1 jd)<br />   (getline pt2 jd)<br />   (sssetfirst nil ssrtl)<br />   )<br />

sicky111

G版的程式可以实现。

chwnin

已OK，但要把多段线改为直线