判断多条直线是否刚好首尾都有连接

328302216

2. (defun c:qt3 (;|/ ss i ss1 ss2 ss3 ss4 ss5 ss6 ss6_1 ss7 ss8 ss9 ss10 a1 a2 a3|;)        ;判断墙体线是否刚好连接
   
3.   (setq ss (ssget))      ;选择对象
   
4.   (setq i 0)
   
5.   (setq ss7 '())
   
6.   (repeat (sslength ss)      ;循环选择对象
   
7.     (setq ss1 (ssname ss i))    ;取得选集中的第一个对象名称
   
8.     (setq ss2 (entget ss1))    ;取得对象所有属性
   
9.     (setq ss3 (cdr (assoc 0 ss2)))  ;取得对象类别（如：LINE CIRCLE）
   
10.     ;(setq ss4 (cdr (assoc 8 ss2)))  ;取得对象的图层
    
11.     (if  (and (= ss3 "LINE") ;|(= ss4 "07结构")|;)
    
12.           ;判断所选对象是否为直线且图层是否为"06轮廓"
    
13.       (progn
    
14.   (setq ss5 (cdr (assoc 10 ss2)))
    
15.   (setq ss6 (cdr (assoc 11 ss2)))
    
16.       )
    
17.     )
    
18.     (setq ss6_1 (list ss5 ss6))    ;将单条直线的端点坐标结合成一列表
    
19.     (setq ss7 (append ss6_1 ss7))  ;将对象结合成一个列表
    
20.     (setq ss6_1 nil)      ;将ss6_1再次设为空列表
    
21.     (setq i (+ 1 i))
    
22.   )
    
23.   (setq ss8 (length ss7))    ;取得ss7列表中的元素个数
    
24.   (setq  a1 0
    
25.   a2 0
    
26.   a3 0
    
27.   )
    
28.   (repeat ss8        ;循环ss8等于ss7列表中的元素个数
    
29.     (setq ss9 (nth a1 ss7))    ; 取得ss7中的第q个元素值并赋给ss9
    
30.     (repeat ss8        ;循环
    
31. ;;;      (setq ss9 (nth a1 ss7))
    
32.       (setq ss10 (nth a2 ss7))    ;  
    
33.       (if (equal ss9 ss10 0.01)    ;判断ss9是否等于ss10，只能用equal判断不能用=判断，因为ss9和ss10里面都有多个元素！
    
34.   (setq a3 (+ 1 a3))    ;如果ss9等于ss10 a3就递增1
    
35.   (setq a3 (+ 0 a3))
    
36.       )          ;if
    
37.       (setq a2 (+ 1 a2))    ;设置取得列表ss7中的第a2个元素递增1
    
38.     )          ;repeat
    
39.     (if  (/= a3 2)      ;判断a3是否等于2
    
40.       (command "CIRCLE" ss9 50)    ;如果a3不等于2就用
    
41.     )          ;if
    
42.     (setq a3   0      ;把这些变量归零
    
43.     ss10 nil
    
44.     a2   0
    
45.     ss9  nil
    
46.     )
    
47.     (setq a1 (+ 1 a1))
    
48.   )          ;repeat
    
49.   (princ)
    
50. )

(defun c:qt3 (;|/ ss i ss1 ss2 ss3 ss4 ss5 ss6 ss6_1 ss7 ss8 ss9 ss10 a1 a2 a3|;)        ;判断墙体线是否刚好连接<br />   (setq ss (ssget))      ;选择对象<br />   (setq i 0)<br />   (setq ss7 '())<br />   (repeat (sslength ss)      ;循环选择对象<br />     (setq ss1 (ssname ss i))    ;取得选集中的第一个对象名称<br />     (setq ss2 (entget ss1))    ;取得对象所有属性<br />     (setq ss3 (cdr (assoc 0 ss2)))  ;取得对象类别（如：LINE CIRCLE）<br />     ;(setq ss4 (cdr (assoc 8 ss2)))  ;取得对象的图层<br />     (if  (and (= ss3 "LINE") ;|(= ss4 "07结构")|;)<br />           ;判断所选对象是否为直线且图层是否为"06轮廓"<br />       (progn<br />   (setq ss5 (cdr (assoc 10 ss2)))<br />   (setq ss6 (cdr (assoc 11 ss2)))<br />       )<br />     )<br />     (setq ss6_1 (list ss5 ss6))    ;将单条直线的端点坐标结合成一列表<br />     (setq ss7 (append ss6_1 ss7))  ;将对象结合成一个列表<br />     (setq ss6_1 nil)      ;将ss6_1再次设为空列表<br />     (setq i (+ 1 i))<br />   )<br />   (setq ss8 (length ss7))    ;取得ss7列表中的元素个数<br />   (setq  a1 0<br />   a2 0<br />   a3 0<br />   )<br />   (repeat ss8        ;循环ss8等于ss7列表中的元素个数<br />     (setq ss9 (nth a1 ss7))    ; 取得ss7中的第q个元素值并赋给ss9<br />     (repeat ss8        ;循环<br /> ;;;      (setq ss9 (nth a1 ss7))<br />       (setq ss10 (nth a2 ss7))    ;  <br />       (if (equal ss9 ss10 0.01)    ;判断ss9是否等于ss10，只能用equal判断不能用=判断，因为ss9和ss10里面都有多个元素！<br />   (setq a3 (+ 1 a3))    ;如果ss9等于ss10 a3就递增1<br />   (setq a3 (+ 0 a3))<br />       )          ;if<br />       (setq a2 (+ 1 a2))    ;设置取得列表ss7中的第a2个元素递增1<br />     )          ;repeat<br />     (if  (/= a3 2)      ;判断a3是否等于2<br />       (command "CIRCLE" ss9 50)    ;如果a3不等于2就用<br />     )          ;if<br />     (setq a3   0      ;把这些变量归零<br />     ss10 nil<br />     a2   0<br />     ss9  nil<br />     )<br />     (setq a1 (+ 1 a1))<br />   )          ;repeat<br />   (princ)<br /> )

感觉还有不少漏洞，希望高手们帮忙打打补丁！

yshf

2. 
   
3. (defun c:ccc()
   
4.      (if (setq ssa (ssget '((0 . "LINE"))))
   
5.          (progn
   
6.              (setq ptb nil  i -1)
   
7.              (repeat (sslength ssa)
   
8.            (setq dxf (entget (ssname ssa (setq i (1+ i))))
   
9.           p10 (cdr (assoc 10 dxf))
   
10.           p11 (cdr (assoc 11 dxf))
    
11.    ptb (cons p11 (cons p10 ptb))
    
12.            )
    
13.       )
    
14.              (setq jgb nil fhz nil)
    
15.              (while (setq pt  (car ptb)
    
16.             ptb (cdr ptb)
    
17.       )
    
18.                  (if (member pt ptb)
    
19.        (setq ptb (vl-remove pt ptb)
    
20.       fhz (cons pt fhz)
    
21.        )
    
22.        (setq jgb (cons pt jgb))
    
23.    )
    
24.                
    
25.       )
    
26.       (mapcar '(lambda(x) (command "_circle" x 50)) jgb)
    
27.    
    
28.       ;变量tymlb储存刚好首尾相接直线的图元名列表
    
29.       (setq tymlb nil)
    
30.       (foreach pt fhz
    
31.                  (setq ssa (ssget "c" pt pt '((0 . "LINE")))
    
32.          i   -1
    
33.    )
    
34.           (repeat (sslength ssa)
    
35.        (if (not (member (setq ent (ssname ssa (setq i (1+ i)))) tymlb))
    
36.            (setq tymlb (cons ent tymlb))
    
37.        )
    
38.    )
    
39.       )
    
40.   )
    
41.      )
    
42.      (princ)
    
43. )

<br /> (defun c:ccc()<br />      (if (setq ssa (ssget '((0 . "LINE"))))<br />          (progn<br />              (setq ptb nil  i -1)<br />              (repeat (sslength ssa)<br />            (setq dxf (entget (ssname ssa (setq i (1+ i))))<br />           p10 (cdr (assoc 10 dxf))<br />           p11 (cdr (assoc 11 dxf))<br />    ptb (cons p11 (cons p10 ptb))<br />            )<br />       )<br />              (setq jgb nil fhz nil)<br />              (while (setq pt  (car ptb)<br />             ptb (cdr ptb)<br />       )<br />                  (if (member pt ptb)<br />        (setq ptb (vl-remove pt ptb)<br />       fhz (cons pt fhz)<br />        )<br />        (setq jgb (cons pt jgb))<br />    )<br />                 <br />       )<br />       (mapcar '(lambda(x) (command "_circle" x 50)) jgb)<br />     <br />       ;变量tymlb储存刚好首尾相接直线的图元名列表<br />       (setq tymlb nil)<br />       (foreach pt fhz<br />                  (setq ssa (ssget "c" pt pt '((0 . "LINE")))<br />          i   -1<br />    )<br />           (repeat (sslength ssa)<br />        (if (not (member (setq ent (ssname ssa (setq i (1+ i)))) tymlb))<br />            (setq tymlb (cons ent tymlb))<br />        )<br />    )<br />       )<br />   )<br />      )<br />      (princ)<br /> )

328302216

程序比我的简洁了好多！

qq229918602

真是复杂、、

328302216

qq229918602 发表于 2011-12-6 21:45
真是复杂、、

新手初学而已，所以有些弯路还是要走的！ 呵呵

功夫佬

判断线段，希望继续完善。

egoroom

希望支持L,PL.ARC等

egoroom

帮完善下。。

328302216

我也好久没整了，而且上面我整的那个也用不上，只是刚学习lisp做的习题！以后我用的上有时间的话就帮你完善

清风明月名字

2楼代码有BUG，1楼的没有发现有
谢谢众位坛友代码分享！