请求帮助选择顺走向的线

434939575

2. ;;====================
   
3. 
   
4. (defun c:tt (/ ang ang:  ang0 app i mid n na na1  obj p1 p2 pa pa: pb pb:
   
5.        ss)
   
6.   ;;可以270度
   
7.           ;
   
8.   (setq jl 0.1)        ;
   
9.   (setq app nil)      ;(setq na (car (entsel "pp")))    ;  
   
10.   (setq s (ssget))
    
11.   (setq na (ssname s 0))
    
12.   (color na 3)
    
13.   (setq pa (vlax-curve-getstartpoint na))
    
14.   (setq pb (vlax-curve-getendpoint na))  ;
    
15.           ;
    
16.   (setq ang (angle pa pb))
    
17.   (if (> ang 6)        ;处理转弯处,6.28->0
    
18.     (setq ang (abs (- ang 6)))
    
19.   )
    
20.   (setq n 1)
    
21.   (while (= n 1)
    
22.     ;;=================================================
    
23.     (setq pt-list (9pt pb jl))
    
24.     (setq ss (ssget "cp" pt-list))
    
25.     ;;==================================================
    
26.           ;  
    
27.     (repeat (setq i (sslength ss))
    
28.       (setq na1 (ssname ss (setq i (1- i))))
    
29.       ;;==============
    
30.       (setq pa: (vlax-curve-getstartpoint na1))
    
31.       (setq pb: (vlax-curve-getendpoint na1))
    
32.       ;;---
    
33.       (if (equal pb pa: 0.1)
    
34.   (progn (setq p1 pa:) (setq p2 pb:))
    
35.   (progn (setq p1 pb:) (setq p2 pa:))
    
36.       )
    
37.       ;;======================
    
38.       (setq ang: (angle p1 p2))
    
39.       (setq obj (vlax-ename->vla-object na1))
    
40.       (setq ang0 (vla-get-angle obj))
    
41.       ;;=====================
    
42.       (if (> ang: 6)      ;处理转弯处,6.28->0
    
43.           ;
    
44.   (setq ang: 0)
    
45.       )
    
46.       ;;==================
    
47.       ;;==================
    
48.       (if (or (equal ang ang: 0.4)  ;
    
49.         (> (abs (- ang: ang)) 5.5) ;
    
50.           ;
    
51.     )
    
52.   (progn (color na1 6)
    
53.          (setq n 1)
    
54.          (setq ang ang:)
    
55.          (setq pb p2)
    
56.   )
    
57.   (progn (setq n 0)    ;
    
58.   )
    
59.       )
    
60.     )          ;
    
61.     ;;==============
    
62.   )          ;while
    
63.           ;          ;
    
64.           ;           ;repeat
    
65. )
    
66. (defun 9pt (pt dis / ang app ii pt1)
    
67.   (setq app ())
    
68.   (setq ii 0)
    
69.   (setq ang 0)
    
70.   (repeat 9
    
71.     (setq pt1 (polar pt ang dis))
    
72.     (setq app (cons pt1 app))
    
73.     (setq ang (+ ang (* 0.25 pi)))
    
74.     (setq ii (1+ ii))
    
75.   )          ;repeat
    
76.   app
    
77. )
    
78. (defun color (na i /)
    
79.   (vla-put-color (vlax-ename->vla-object na) i)
    
80. )
    
81. 
    
82. 
    
83. 
    
84. 
    
85.           ;  
    
86. 
    
87.           ;
    
88. 
    

;;====================<br /> <br /> (defun c:tt (/ ang ang:  ang0 app i mid n na na1  obj p1 p2 pa pa: pb pb:<br />        ss)<br />   ;;可以270度<br />           ;<br />   (setq jl 0.1)        ;<br />   (setq app nil)      ;(setq na (car (entsel "pp")))    ;  <br />   (setq s (ssget))<br />   (setq na (ssname s 0))<br />   (color na 3)<br />   (setq pa (vlax-curve-getstartpoint na))<br />   (setq pb (vlax-curve-getendpoint na))  ;<br />           ;<br />   (setq ang (angle pa pb))<br />   (if (> ang 6)        ;处理转弯处,6.28->0<br />     (setq ang (abs (- ang 6)))<br />   )<br />   (setq n 1)<br />   (while (= n 1)<br />     ;;=================================================<br />     (setq pt-list (9pt pb jl))<br />     (setq ss (ssget "cp" pt-list))<br />     ;;==================================================<br />           ;  <br />     (repeat (setq i (sslength ss))<br />       (setq na1 (ssname ss (setq i (1- i))))<br />       ;;==============<br />       (setq pa: (vlax-curve-getstartpoint na1))<br />       (setq pb: (vlax-curve-getendpoint na1))<br />       ;;---<br />       (if (equal pb pa: 0.1)<br />   (progn (setq p1 pa:) (setq p2 pb:))<br />   (progn (setq p1 pb:) (setq p2 pa:))<br />       )<br />       ;;======================<br />       (setq ang: (angle p1 p2))<br />       (setq obj (vlax-ename->vla-object na1))<br />       (setq ang0 (vla-get-angle obj))<br />       ;;=====================<br />       (if (> ang: 6)      ;处理转弯处,6.28->0<br />           ;<br />   (setq ang: 0)<br />       )<br />       ;;==================<br />       ;;==================<br />       (if (or (equal ang ang: 0.4)  ; <br />         (> (abs (- ang: ang)) 5.5) ;<br />           ;<br />     )<br />   (progn (color na1 6)<br />          (setq n 1)<br />          (setq ang ang:)<br />          (setq pb p2)<br />   )<br />   (progn (setq n 0)    ;<br />   )<br />       )<br />     )          ; <br />     ;;==============<br />   )          ;while<br />           ;          ;<br />           ;           ;repeat<br /> )<br /> (defun 9pt (pt dis / ang app ii pt1)<br />   (setq app ())<br />   (setq ii 0)<br />   (setq ang 0)<br />   (repeat 9<br />     (setq pt1 (polar pt ang dis))<br />     (setq app (cons pt1 app))<br />     (setq ang (+ ang (* 0.25 pi)))<br />     (setq ii (1+ ii))<br />   )          ;repeat<br />   app<br /> )<br /> (defun color (na i /)<br />   (vla-put-color (vlax-ename->vla-object na) i)<br /> )<br /> <br /> <br /> <br /> <br />           ;  <br /> <br />           ;<br /> <br />

请修改下，按线走向选择此线，边上有其他线在此线交点处相交，外边杂线不变色

434939575

原线其他软件转过来的，下面连接后炸开，效果好些，干扰没处理好，请大师指导.