线相交检查

永不言弃

好的，谢谢

xujinhua

顶到高手出来........

荒野孤行

1. ;;;查找相交线（短路）
   
2. (defun c:xj        (/ objlis)
   
3.   (princ "选取直线、多段线、圆、圆弧、样条曲线：")  
   
4.   (vl-load-com)
   
5.   (setq
   
6.     ss (ssget '((0 . "LWPOLYLINE,POLYLINE,ARC,CIRCLE,SPLINE,LINE"))
   
7.        )
   
8.   )
   
9.   (if (not ss)
   
10.     (progn (princ "\n提示：未选取对象.") (exit))
    
11.   )
    
12.   (setvar "osmode" 0)
    
13.   (setq        i   0
    
14.         num (sslength ss)
    
15.   )
    
16.   (command "LAYER" "M" "层-短路" "C" "251" "层-短路" "")
    
17.   (repeat num
    
18.     (setq ent (ssname ss i)
    
19.           obj (vlax-ename->vla-object ent)
    
20.     )
    
21.     (setq objlis (cons obj objlis))
    
22.     (setq i (1+ i))
    
23.   )
    
24.   (setq i 0)
    
25.   (while (< i (- (length objlis) 1))
    
26.     (setq obj1 (nth i objlis))
    
27.     (setq j (+ 1 i))
    
28.     (while (< j (length objlis))
    
29.       (setq obj2 (nth j objlis))
    
30.       (if (vlax-invoke obj1 'intersectwith obj2 0)
    
31.         (progn
    
32.           (vla-put-Layer obj1 "层-短路")
    
33.           (vla-put-Layer obj2 "层-短路")
    
34.         )
    
35.       )
    
36.       (setq j (1+ j))
    
37.     )
    
38. 
    
39.     (setq i (1+ i))
    
40.   )
    
41.   (alert
    
42.     "★提示：如果存在短路的对象，会把它们置于“层-短路”图层！"
    
43.   )
    
44. (alert "若需了解更多功能的程序，欢迎下载WDY工具箱。")
    
45. (command "BROWSER" "http://bbs.mjtd.com/thread-108389-1-1.html")
    
46.   (princ)
    
47. )
    

;;;查找相交线（短路）<br /> (defun c:xj        (/ objlis)<br />   (princ "选取直线、多段线、圆、圆弧、样条曲线：")  <br />   (vl-load-com)<br />   (setq<br />     ss (ssget '((0 . "LWPOLYLINE,POLYLINE,ARC,CIRCLE,SPLINE,LINE"))<br />        )<br />   )<br />   (if (not ss)<br />     (progn (princ "\n提示：未选取对象.") (exit))<br />   )<br />   (setvar "osmode" 0)<br />   (setq        i   0<br />         num (sslength ss)<br />   )<br />   (command "LAYER" "M" "层-短路" "C" "251" "层-短路" "")<br />   (repeat num<br />     (setq ent (ssname ss i)<br />           obj (vlax-ename->vla-object ent)<br />     )<br />     (setq objlis (cons obj objlis))<br />     (setq i (1+ i))<br />   )<br />   (setq i 0)<br />   (while (< i (- (length objlis) 1))<br />     (setq obj1 (nth i objlis))<br />     (setq j (+ 1 i))<br />     (while (< j (length objlis))<br />       (setq obj2 (nth j objlis))<br />       (if (vlax-invoke obj1 'intersectwith obj2 0)<br />         (progn<br />           (vla-put-Layer obj1 "层-短路")<br />           (vla-put-Layer obj2 "层-短路")<br />         )<br />       )<br />       (setq j (1+ j))<br />     )<br /> <br />     (setq i (1+ i))<br />   )<br />   (alert<br />     "★提示：如果存在短路的对象，会把它们置于“层-短路”图层！"<br />   )<br /> (alert "若需了解更多功能的程序，欢迎下载WDY工具箱。")<br /> (command "BROWSER" "http://bbs.mjtd.com/thread-108389-1-1.html")<br />   (princ)<br /> )<br />