[求助]：打断选择范围内的直线函数有BUGS请高手看！

gewanjia

这是我一个小型程序一个命令，但是有点问题。
主要是brLineIntersection函数效率底，并且ssget选取模式有问题，
正常情况下应该返回2，因为我画图中很少有三线共点。
这个问题郁闷死我 ，我都搞了三天。
清高手解决！！！

2. 
   
3. ;这个函数主要为了打断所有直线的交点
   
4. ;问题主要表现在交点打断命令非常没有效率。
   
5. 
   
6. 
   
7.    (VL-LOAD-COM)
   
8. 
   
9.    (setq AcadObject(vlax-get-acad-object))      
   
10.    (setq AcadDocument(vla-get-ActiveDocument Acadobject))
    
11.    (setq mSpace(vla-get-ModelSpace Acaddocument))        ;获得模型空间指针
    
12. 
    
13. 
    
14. ( defun c:Ol( / lineObjNames )  ;主函数
    
15. 
    
16.     (setq lineObjNames (ssget  '((0 . "LINE"))))        ;获取模型空间所有的直线
    
17.     (brLineIntersection(FindIntersections lineObjNames))
    
18.    
    
19. )
    
20. 
    
21. 
    
22. ;找出所有的交点
    
23. 
    
24. (defun FindIntersections( lineObjNames /  vlaCol tmp i n point pointCol)
    
25. 
    
26.     (setq s (getvar "DATE"))             ;分析消耗时间
    
27.     (setq seconds1 (* 86400.0 (- s (fix s))))
    
28.    
    
29.     (setq n (sslength lineObjNames ))                       
    
30.     (setq i -1)
    
31.         
    
32.     (setq pointCol (list ))                           ;定义点集
    
33.     (setq vlaCol (list ))                             ;定义对象集
    
34.    
    
35.     ( repeat n
    
36. 
    
37.         (setq tmp (ssname lineObjNames (setq i (1+ i))))       ;把ENAME批量转换成VLA对象
    
38.         (setq tmp (vlax-ename->vla-object tmp))
    
39.         (setq vlaCol ( cons tmp vlaCol))
    
40.     )
    
41. 
    
42.     (setq this (nth 0 vlaCol ))
    
43.      
    
44.     ( while (/= nil this )  ;找出所有得点
    
45.        
    
46.         (setq i 1)
    
47. 
    
48.         ( repeat (- (vl-list-length vlaCol) 1)               
    
49.        
    
50.                 (setq next (nth i vlaCol))
    
51.                                         
    
52.                 (setq point(vla-IntersectWith this next acExtendNone))
    
53.                              
    
54.                 (setq tmp (vl-catch-all-apply                    ;捕捉activX返回的错误。
    
55.                                 'vlax-safearray->list
    
56.                                 (list (vlax-variant-value point))
    
57.                              )
    
58.                       )
    
59. 
    
60.                 (if (= nil (vl-catch-all-error-p tmp))           ;正确的点存入点集
    
61.                                                            
    
62.                             (setq pointCol (cons point pointCol))
    
63.        
    
64.                   )
    
65. 
    
66.                 (setq i (1+ i))
    
67.            )
    
68.       
    
69.          (setq vlaCol (vl-catch-all-apply                    ;捕捉activX返回的错误。
    
70.                                 'vl-remove
    
71.                                 (list this vlaCol)
    
72.                              )
    
73.                       )
    
74.       
    
75.       (if (= vlaCol nil)
    
76.           (setq this nil)      
    
77.           (setq this (nth 0 vlaCol )))                  
    
78. 
    
79.    )
    
80. 
    
81.    (setq s (getvar "DATE"))             ;分析消耗时间
    
82.    (setq seconds2 (* 86400.0 (- s (fix s))))
    
83.    (princ (- seconds2 seconds1))
    
84.    (princ "\n")
    
85.    (princ (length  pointCol))             ;返回交点的个数。
    
86.    pointCol
    
87.   
    
88. )
    
89. 
    
90.    
    
91. 
    
92. ;打断所有交点
    
93. ( defun brLineIntersection(pointCol / i j point x y cornerUpLeft cornerDownRight
    
94.                                    intersectionCol LineObj tmp)
    
95. 
    
96.     (setq s (getvar "DATE"))             ;分析消耗时间
    
97.     (setq seconds1 (* 86400.0 (- s (fix s))))
    
98. 
    
99. 
    
100.   (setq i 0)
     
101. 
     
102.     (repeat (vl-list-length pointCol)
     
103. 
     
104.             (setq point ( nth i pointCol))
     
105. 
     
106.         (setq x (car point))
     
107.         (setq y (cadr point))
     
108. 
     
109.         (setq cornerUpLeft   (list (- x 0.01) (+ y 0.01)))       ;计算范围
     
110.         (setq cornerDownRight(list (+ x 0.01) (- y 0.01)))
     
111. 
     
112.         (setq intersectionCol (ssget "C" cornerUpLeft cornerDownRight))    ;关键在这里，问题是如果对象在屏幕过密
     
113.                                                                            ;intersectionCol返回数量特大，我不知道为什么
     
114.                                                                            ;但是对象间距还是超过范围很多倍！
     
115.                                                                            ;还有很多类似的问题，明明一样，就他妈不行！！
     
116.         (setq j 0)
     
117.                                                                           
     
118.         (repeat (sslength intersectionCol)       ;打断所有直线
     
119.             
     
120.             (setq LineObj (ssname intersectionCol j))                  
     
121.                 (BrLine LineObj point)                  ;断点
     
122.             (setq j (1+ j))
     
123.          )
     
124. 
     
125.         (setq i (1+ i))
     
126. 
     
127.      )
     
128. 
     
129.    (setq s (getvar "DATE"))
     
130.    (setq seconds2 (* 86400.0 (- s (fix s))))
     
131.    (princ "\n")
     
132.    (princ (- seconds2 seconds1))
     
133.   
     
134. )
     
135. 
     
136. 
     
137. 
     
138. 
     
139. 
     
140. ;增强型直线打断函数。
     
141. 
     
142. (defun BrLine(LineObj point / a StartPoint EndPoint)
     
143. 
     
144.     (setq LineObj (vlax-ename->vla-object LineObj))
     
145. 
     
146.     (setq StartPoint (vla-get-StartPoint LineObj))
     
147.     (setq EndPoint   (vla-get-EndPoint   LineObj))
     
148.     (vla-delete LineObj)
     
149.       
     
150.     (setq point (vlax-3d-point point))
     
151.     (setq a(vla-addLine mSpace StartPoint point))
     
152.     (vla-update a)
     
153.     (setq a(vla-addLine mSpace EndPoint   point))
     
154.     (vla-update a)
     
155.   )

<br /> ;这个函数主要为了打断所有直线的交点<br /> ;问题主要表现在交点打断命令非常没有效率。<br /> <br /> <br />    (VL-LOAD-COM)<br /> <br />    (setq AcadObject(vlax-get-acad-object))      <br />    (setq AcadDocument(vla-get-ActiveDocument Acadobject))<br />    (setq mSpace(vla-get-ModelSpace Acaddocument))        ;获得模型空间指针<br /> <br /> <br /> ( defun c:Ol( / lineObjNames )  ;主函数<br /> <br />     (setq lineObjNames (ssget  '((0 . "LINE"))))        ;获取模型空间所有的直线 <br />     (brLineIntersection(FindIntersections lineObjNames))<br />    <br /> )<br /> <br /> <br /> ;找出所有的交点<br /> <br /> (defun FindIntersections( lineObjNames /  vlaCol tmp i n point pointCol)<br /> <br />     (setq s (getvar "DATE"))             ;分析消耗时间<br />     (setq seconds1 (* 86400.0 (- s (fix s))))<br />     <br />     (setq n (sslength lineObjNames ))                       <br />     (setq i -1)<br />         <br />     (setq pointCol (list ))                           ;定义点集<br />     (setq vlaCol (list ))                             ;定义对象集<br />     <br />     ( repeat n<br /> <br />         (setq tmp (ssname lineObjNames (setq i (1+ i))))       ;把ENAME批量转换成VLA对象<br />         (setq tmp (vlax-ename->vla-object tmp))<br />         (setq vlaCol ( cons tmp vlaCol))<br />     )<br /> <br />     (setq this (nth 0 vlaCol ))<br />      <br />     ( while (/= nil this )  ;找出所有得点<br />         <br />         (setq i 1)<br /> <br />         ( repeat (- (vl-list-length vlaCol) 1)               <br />         <br />                 (setq next (nth i vlaCol))<br />                                         <br />                 (setq point(vla-IntersectWith this next acExtendNone))<br />                               <br />                 (setq tmp (vl-catch-all-apply                    ;捕捉activX返回的错误。<br />                                 'vlax-safearray->list<br />                                 (list (vlax-variant-value point))<br />                              )<br />                       )<br /> <br />                 (if (= nil (vl-catch-all-error-p tmp))           ;正确的点存入点集<br />                                                             <br />                             (setq pointCol (cons point pointCol))<br />         <br />                   )<br /> <br />                 (setq i (1+ i))<br />            )<br />       <br />          (setq vlaCol (vl-catch-all-apply                    ;捕捉activX返回的错误。<br />                                 'vl-remove<br />                                 (list this vlaCol)<br />                              )<br />                       )<br />        <br />       (if (= vlaCol nil)<br />           (setq this nil)      <br />           (setq this (nth 0 vlaCol )))                   <br /> <br />    )<br /> <br />    (setq s (getvar "DATE"))             ;分析消耗时间<br />    (setq seconds2 (* 86400.0 (- s (fix s))))<br />    (princ (- seconds2 seconds1))<br />    (princ "\n")<br />    (princ (length  pointCol))             ;返回交点的个数。<br />    pointCol<br />   <br /> )<br /> <br />    <br /> <br /> ;打断所有交点<br /> ( defun brLineIntersection(pointCol / i j point x y cornerUpLeft cornerDownRight<br />                                    intersectionCol LineObj tmp)<br /> <br />     (setq s (getvar "DATE"))             ;分析消耗时间<br />     (setq seconds1 (* 86400.0 (- s (fix s))))<br /> <br /> <br />   (setq i 0)<br /> <br />     (repeat (vl-list-length pointCol)<br /> <br />             (setq point ( nth i pointCol))<br /> <br />         (setq x (car point))<br />         (setq y (cadr point))<br /> <br />         (setq cornerUpLeft   (list (- x 0.01) (+ y 0.01)))       ;计算范围<br />         (setq cornerDownRight(list (+ x 0.01) (- y 0.01)))<br /> <br />         (setq intersectionCol (ssget "C" cornerUpLeft cornerDownRight))    ;关键在这里，问题是如果对象在屏幕过密<br />                                                                            ;intersectionCol返回数量特大，我不知道为什么<br />                                                                            ;但是对象间距还是超过范围很多倍！<br />                                                                            ;还有很多类似的问题，明明一样，就他妈不行！！<br />         (setq j 0)<br />                                                                           <br />         (repeat (sslength intersectionCol)       ;打断所有直线<br />             <br />             (setq LineObj (ssname intersectionCol j))                   <br />                 (BrLine LineObj point)                  ;断点<br />             (setq j (1+ j))<br />          )<br /> <br />         (setq i (1+ i))<br /> <br />      )<br /> <br />    (setq s (getvar "DATE"))<br />    (setq seconds2 (* 86400.0 (- s (fix s))))<br />    (princ "\n")<br />    (princ (- seconds2 seconds1))<br />   <br /> )<br /> <br /> <br /> <br /> <br /> <br /> ;增强型直线打断函数。<br /> <br /> (defun BrLine(LineObj point / a StartPoint EndPoint)<br /> <br />     (setq LineObj (vlax-ename->vla-object LineObj))<br /> <br />     (setq StartPoint (vla-get-StartPoint LineObj))<br />     (setq EndPoint   (vla-get-EndPoint   LineObj))<br />     (vla-delete LineObj)<br />       <br />     (setq point (vlax-3d-point point))<br />     (setq a(vla-addLine mSpace StartPoint point))<br />     (vla-update a)<br />     (setq a(vla-addLine mSpace EndPoint   point))<br />     (vla-update a) <br />   )

Underway

(setq lineObjNames (ssget '((0 . "LINE")))) ;获取模型空间所有的直线

===>
(setq lineObjNames (ssget  "X" '((0 . "LINE")))) ;获取模型空间所有的直线

gewanjia

我这个程序是手动选择 ，不是全部选择，再说问题不是在那里呀！！
主要是打断后，图元名变了，得在交点附近选取，图元。
还有就是精度问题。
请高手解释

aeo

打断实体后会新生成实体:
-------直线起点的是老实体.

为了不必要的麻烦应该把 每一线和所有线的交点 都求出来 ,在分别打断.
打断时,从后面起(交点要排序)
如果从前面起,就要对新实体打断了,排序是不可避免的

gewanjia

我在FindIntersections函数中已经求出全部的交点了，并且我自信没有问题。
问题确实是在打断时会生成新的图元，关键是我利用交点附近来选取图元，因为图元变了，所以每个交点都要选择图元。
并且我自信 算法应该不是问题，问题是选取时SSGET函数好像不听使唤。

Underway

每一直线打断后
连同新产生的新图元
拨入冻结的临时图层

eachy

既然用了 ssget "C" 当然要先关闭捕捉

dandee

算法有问题，换换脑子。
1，建议换一种打断直线的算法
2，“(setq intersectionCol (ssget "C" cornerUpLeft cornerDownRight)) ;关键在这里，问题是如果对象在屏幕过密”
用这种方法找图元，吃力不讨好。（“ssget触角”是lisp编程的好技巧，但面临的风险，就是你现在遇到的问题，我也遇到过，我一直怀疑是acad分辨率的问题影响ssget的选择集合，能解决的就是绕到走）

解决 思路：第一步，所有线的交点集(p1 p2 p3..pn)（已经有了）
           第二步，i ) 判断一条直线上有几个交点p1,p2..pn.
                                    ( 子程序 一点是否在一直线上）
                   ii) 并且把有交点的直线做成集合 A
             (                     ( line-1_name p1 p2..)
                                      ( line-2_name p2 p4 ....)
                                      (...)
                                     (line-n_name p1 p4 ..pn)          )
     
                         第三步，做个子程序B，对一条直线上有p1 p2 ..pn个点，保留这条直线的特征，
                复制重画连接n点--> （n + 1)  段 （这样就避开了找新图元的麻烦）
             最后一步 ，把子程序B 循环作用于 集合 A中的每一条直线
这样“断点”成功！！

gewanjia

楼上的你是这里回答最好的，真正高手！！！，我一般给人解决问题，终于有人给我解决问题了！！！感谢！！！
看来只要我把FindIntersections函数稍微改动一下就可以了，
首先 ，求出this直线的起点和末点。建立一个list，把起点先存进，然后我的把这this和
其他直线交点也存进去，最后把末点存进去。

然后编写 ，函数对这个list排序，因为this和其他直线交点不许按顺序来，如果不排序新直线会重叠的。（这也会牺牲很多的效率的！！）

最后，打断就可以了。圆满解决，
你是值得尊敬高手 ！！！　　

eachy

最初由 gewanjia 发布
[B]楼上的你是这里回答最好的，真正高手！！！，我一般给人解决问题，终于有人给我解决问题了！！！感谢！！！
看来只要我把FindIntersections函数稍微改动一下就可以了，
首先 ，求出this直线的起点和末点。建立一个... [/B]

把你修改的成果贴上来吧

狂刀

取得曲线与曲线选集的交点集后别忘了排序

eachy

Line 的交点就没必要用“牛刀”-Intersectwith 了，用 vlax-curve-xxx  和 inters 就可以，可以参考函数库的直线交点函数。

增强断开用 entmake 效率是非常高的，Vla 函数是不错，但要根据程序的需要来确定，既要程序的简洁，最重要的是程序的效率。除在非Vla函数不能解决问题，或者用Lisp要很罗嗦时才建议使用 vla ，Lisp 能搞定时还是 纯 Autolisp 。

dandee

不过，我觉得如果这个程序能够把*line 和曲线断点也考虑进去就更完美了

狂刀

如果纯粹是ｌｉｎｅ或ａｒｃ，ｃｉｒｃｌｅ，就可以用数学方法+entmake做（直线可以用ｉｎｔｅｒｓ），如果要适应各种曲线，那就用intersectwith＋ｂｒｅａｋ。效率相差多少，没有比较过，望有人能搞一下

gewanjia

看了前面几位大虾的言论，使小弟受益非浅。
我始终觉得 activeX方法执行速度比纯AUTOLISP要快，所以我才在找交点函数，几乎用ACTIVEX
方法，但是斑竹说了 ；我还是愿意尝试一下的：
下面是改过的函数速度有点慢！！我一向是效率狂人的！！
打断20000交点用158s，我的机器配置为:Ce850 内存128  winXP  AutoCAD2006.
;
;
;在函数中有计算消耗时间的代码：：
;如果大家需要把ARC加入 我也可以尝试，但小弟学习AUTOLISP才1.5个月。

2. 
   
3. ( defun c:OL( / lineObjNames AcadObject AcadDocument)   ;主函数
   
4.   
   
5.    (VL-LOAD-COM)
   
6. 
   
7.    (setq AcadObject(vlax-get-acad-object))      
   
8.    (setq AcadDocument(vla-get-ActiveDocument Acadobject))
   
9.    (setq mSpace(vla-get-ModelSpace Acaddocument))        ;获得模型空间指针
   
10. 
    
11. 
    
12.    (setq lineObjNames (ssget  '((0 . "LINE"))))        ;获取模型空间所有的直线  
    
13.    (LinePointOrder(FindIntersections lineObjNames))
    
14.    (princ)
    
15. )
    
16. 
    
17. 
    
18. ;找出所有直线上的交点
    
19. 
    
20. (defun FindIntersections( lineObjNames /  vlaCol lineCol linePointCol tmp i j n point
    
21.                                           this next StartPoint EndPoint)
    
22. 
    
23.    (setq s (getvar "DATE"))
    
24.    (setq seconds1 (* 86400.0 (- s (fix s))))
    
25.                              
    
26.    (setq i -1)
    
27.         
    
28.    (setq lineCol (list ))                            ;定义直线集
    
29.    (setq vlaCol (list ))                             ;定义直线对象集
    
30.    (setq n (sslength lineObjNames ))  
    
31.       
    
32.    ( repeat n
    
33. 
    
34.         (setq tmp (ssname lineObjNames (setq i (1+ i))))       ;把ENAME批量转换成VLA对象
    
35.         (setq tmp (vlax-ename->vla-object tmp))
    
36.         (setq vlaCol ( cons tmp vlaCol))
    
37.    )
    
38. 
    
39.    (setq j 0)
    
40.   
    
41.    ( repeat n    ;找出直线上所有的交点，但不包括开始点和结束点
    
42.        
    
43. 
    
44.         (setq this (nth j vlaCol ))
    
45.      
    
46.         (setq linePointCol(list))                  ;定义在直线上的点集
    
47. 
    
48.            (setq StartPoint  (vla-get-StartPoint this))           ;开始点
    
49.            (setq EndPoint    (vla-get-EndPoint   this))           ;结束点
    
50.      
    
51.         (setq linePointCol(cons EndPoint linePointCol))      ;加入结束点
    
52. 
    
53.         (setq i 0)   
    
54.         ( repeat (- n 1)               
    
55.        
    
56.                 (if (= i j) (setq i (1+ i)))               ;如果是本身跳过
    
57.                 (setq next (nth i vlaCol))
    
58.                                         
    
59.                 (setq point(vla-IntersectWith this next acExtendNone))
    
60.                              
    
61.                 (setq tmp (vl-catch-all-apply               ;捕捉activX返回的错误。
    
62.                                 'vlax-safearray->list
    
63.                                 (list (vlax-variant-value point))
    
64.                              )
    
65.                       )
    
66. 
    
67.                 (if (= nil (vl-catch-all-error-p tmp))      ;正确的点存入点集
    
68.                                                            
    
69.                         (if (JudgeAnastomosis this point)               
    
70.                                   (setq linePointCol (cons point linePointCol))                                            
    
71.                           )       
    
72.                   )
    
73. 
    
74.                 (setq i (1+ i))
    
75.            )
    
76.    
    
77.       (setq linePointCol(cons StartPoint linePointCol))     ;加入开始点              
    
78.       (setq lineCol (cons linePointCol lineCol))
    
79.       (setq j (1+ j))               
    
80.       (setq this (nth j vlaCol ))                   ;提取下一个点  
    
81. 
    
82.    )
    
83. 
    
84.    ( setq i 0)
    
85.    (repeat n                           ;删原有直线。
    
86.      (setq tmp (nth i vlaCol ))
    
87.      (vla-delete tmp)
    
88.      (setq i (1+ i))
    
89.    )
    
90. 
    
91.    lineCol
    
92.   
    
93. )
    
94.    
    
95. 
    
96. 
    
97. ;这个函数主要处理首尾相接的那种直线，因为vla-IntersectWith认为那种形式也算相交。
    
98. ;在大多数情况，不需要那种类型的。
    
99. 
    
100. (defun JudgeAnastomosis(LineObj point / StartPoint EndPoint result)
     
101. 
     
102.    (setq StartPoint (vla-get-StartPoint LineObj))
     
103.    (setq EndPoint   (vla-get-EndPoint   LineObj))
     
104.   
     
105.    (setq point     (vlax-safearray->list(vlax-variant-value point     )))  
     
106.    (setq StartPoint(vlax-safearray->list(vlax-variant-value StartPoint)))
     
107.    (setq EndPoint  (vlax-safearray->list(vlax-variant-value EndPoint  )))
     
108.         
     
109.    ( if (or (equal StartPoint point 0.01 )
     
110.             (equal EndPoint   point 0.01))
     
111.           
     
112.       (setq result nil)
     
113.       (setq result T)
     
114.      )
     
115. 
     
116.   result
     
117. )
     
118. 
     
119. ;给直线上交点排序，要不会重叠的，效率太底，希望高手有好方法。
     
120. ;说明我的算法，1、判断直线是否垂直，如果垂直由Y来排序；如果不垂直用X来排序。
     
121. ;              2、确定StartPoint中X或Y值是否为最大值，来确定排序是选取最大还是最小。
     
122. ;              3、选出一个生成一个直线。
     
123. ;
     
124. ;真是狂晕，真是太慢了
     
125. 
     
126. ( defun LinePointOrder( lineCol / num line n i j tmp tmpLine StartPoint EndPoint
     
127.                                    on this L)
     
128. 
     
129.   (setq num 0)
     
130. 
     
131.   (repeat (vl-list-length lineCol)            ;根据直线多少来确定次数
     
132.   
     
133.     (setq line (nth num lineCol ))                   ;应该递增
     
134.    
     
135.     (setq tmpLine (list))
     
136.     (setq j 1)
     
137.     (setq n (vl-list-length line))             ;根据直线上的点确定次数
     
138.    
     
139.     (repeat n
     
140. 
     
141.       (setq tmp (nth (- n j) line))
     
142.       (setq tmp(vlax-safearray->list(vlax-variant-value tmp)))
     
143.       (setq tmpLine (cons tmp tmpLine))
     
144.       (setq j (1+ j))
     
145.     )
     
146.     (setq line tmpLine)
     
147.               
     
148.     (setq  StartPoint(nth  0     line))
     
149.     (setq  EndPoint  (nth (1- n) line))
     
150.     (setq  ls  (vlax-3d-point StartPoint))          ;保存直线最开始点
     
151. 
     
152.     (if (equal (car StartPoint) (car EndPoint) 0.0005)   ;判断直线是否为90度
     
153. 
     
154.        (progn
     
155.                                                         ;利用Y值来确定，线段交点顺序。          
     
156.           (setq tmp(nth 1 line))
     
157.          
     
158.           (setq on(> (cadr StartPoint) (cadr tmp)))    ;判断StartPoint是否为最大值
     
159.                              
     
160.           (repeat  (1- n)            
     
161.                              
     
162.             (setq this (nth 1 line))
     
163.             (setq tmp this)         
     
164.             (setq j 1)                       ;总是取第2个元素开始比较            
     
165.                
     
166.             (while tmp                       ;求出下一个线段结束点。               
     
167.                  
     
168.               (if on
     
169.                 (progn                                                         
     
170.                    (if (< (cadr this) (cadr tmp))                  ;求大的
     
171.                      (setq this tmp)
     
172.                    )
     
173.                  )
     
174.                 (progn                                                         
     
175.                   (if (> (cadr this) (cadr tmp))                  ;求小的
     
176.                     (setq this tmp)
     
177.                     )
     
178.                   )
     
179.                 )
     
180.               (setq j (1+ j))
     
181.               (setq tmp (nth j line))
     
182.             )
     
183.                 (setq line (vl-remove this line))           
     
184.                 (setq this(vlax-3d-point this))             ;转化为变体。
     
185.                 (setq L(vla-addLine mSpace ls this))        ;把破碎的直线重新连接起来               
     
186.                 (setq ls this)                       ;将下一个线段的开始点保存起来。
     
187.                 
     
188.           )
     
189.         )
     
190.       
     
191. 
     
192.         (progn
     
193.                                                         ;利用X值来确定，线段交点顺序。          
     
194.           (setq tmp(nth 1 line))
     
195.          
     
196.           (setq on(> (car StartPoint) (car tmp)))    ;判断StartPoint是否为最大值
     
197.                              
     
198.           (repeat  (1- n)           
     
199.                              
     
200.             (setq this (nth 1 line))
     
201.             (setq tmp this)         
     
202.             (setq j 1)                       ;总是取第2个元素开始比较            
     
203.                
     
204.             (while tmp                       ;求出下一个线段结束点。               
     
205.                  
     
206.               (if on
     
207.                 (progn                                                         
     
208.                    (if (< (car this) (car tmp))                  ;求大的
     
209.                      (setq this tmp)
     
210.                    )
     
211.                  )
     
212.                 (progn                                                         
     
213.                   (if (> (car this) (car tmp))                  ;求小的
     
214.                     (setq this tmp)
     
215.                     )
     
216.                   )
     
217.                 )
     
218.               (setq j (1+ j))
     
219.               (setq tmp (nth j line))
     
220.             )
     
221.                 (setq line (vl-remove this line))           
     
222.                 (setq this(vlax-3d-point this))             ;转化为变体。
     
223.                 (setq L(vla-addLine mSpace ls this))        ;把破碎的直线重新连接起来               
     
224.                 (setq ls this)                       ;将下一个线段的开始点保存起来。
     
225.                 
     
226.           )
     
227.         )
     
228.       )
     
229.    
     
230.     (setq num (1+ num))
     
231. 
     
232.   )
     
233.                       
     
234.    (setq s (getvar "DATE"))
     
235.    (setq seconds2 (* 86400.0 (- s (fix s))))         ;计算消耗时间
     
236.    (princ "\n打断消耗时间:")(princ (- seconds2 seconds1))(princ "秒")
     
237. )

<br /> ( defun c:OL( / lineObjNames AcadObject AcadDocument)   ;主函数<br />   <br />    (VL-LOAD-COM)<br /> <br />    (setq AcadObject(vlax-get-acad-object))      <br />    (setq AcadDocument(vla-get-ActiveDocument Acadobject))<br />    (setq mSpace(vla-get-ModelSpace Acaddocument))        ;获得模型空间指针<br /> <br /> <br />    (setq lineObjNames (ssget  '((0 . "LINE"))))        ;获取模型空间所有的直线  <br />    (LinePointOrder(FindIntersections lineObjNames)) <br />    (princ)<br /> )<br /> <br /> <br /> ;找出所有直线上的交点<br /> <br /> (defun FindIntersections( lineObjNames /  vlaCol lineCol linePointCol tmp i j n point <br />                                           this next StartPoint EndPoint)<br /> <br />    (setq s (getvar "DATE"))<br />    (setq seconds1 (* 86400.0 (- s (fix s))))<br />                              <br />    (setq i -1)<br />         <br />    (setq lineCol (list ))                            ;定义直线集<br />    (setq vlaCol (list ))                             ;定义直线对象集<br />    (setq n (sslength lineObjNames ))  <br />       <br />    ( repeat n<br /> <br />         (setq tmp (ssname lineObjNames (setq i (1+ i))))       ;把ENAME批量转换成VLA对象<br />         (setq tmp (vlax-ename->vla-object tmp))<br />         (setq vlaCol ( cons tmp vlaCol))<br />    )<br /> <br />    (setq j 0)<br />   <br />    ( repeat n    ;找出直线上所有的交点，但不包括开始点和结束点<br />         <br /> <br />         (setq this (nth j vlaCol ))<br />      <br />         (setq linePointCol(list))                  ;定义在直线上的点集<br /> <br />            (setq StartPoint  (vla-get-StartPoint this))           ;开始点<br />            (setq EndPoint    (vla-get-EndPoint   this))           ;结束点<br />      <br />         (setq linePointCol(cons EndPoint linePointCol))      ;加入结束点<br /> <br />         (setq i 0)    <br />         ( repeat (- n 1)               <br />         <br />                 (if (= i j) (setq i (1+ i)))               ;如果是本身跳过<br />                 (setq next (nth i vlaCol))<br />                                         <br />                 (setq point(vla-IntersectWith this next acExtendNone))<br />                               <br />                 (setq tmp (vl-catch-all-apply               ;捕捉activX返回的错误。<br />                                 'vlax-safearray->list<br />                                 (list (vlax-variant-value point))<br />                              )<br />                       )<br /> <br />                 (if (= nil (vl-catch-all-error-p tmp))      ;正确的点存入点集<br />                                                             <br />                         (if (JudgeAnastomosis this point)                <br />                                   (setq linePointCol (cons point linePointCol))                                             <br />                           )        <br />                   )<br /> <br />                 (setq i (1+ i))<br />            )<br />    <br />       (setq linePointCol(cons StartPoint linePointCol))     ;加入开始点              <br />       (setq lineCol (cons linePointCol lineCol))<br />       (setq j (1+ j))               <br />       (setq this (nth j vlaCol ))                   ;提取下一个点  <br /> <br />    )<br /> <br />    ( setq i 0)<br />    (repeat n                           ;删原有直线。<br />      (setq tmp (nth i vlaCol ))<br />      (vla-delete tmp)<br />      (setq i (1+ i))<br />    )<br /> <br />    lineCol<br />   <br /> )<br />    <br /> <br /> <br /> ;这个函数主要处理首尾相接的那种直线，因为vla-IntersectWith认为那种形式也算相交。<br /> ;在大多数情况，不需要那种类型的。<br /> <br /> (defun JudgeAnastomosis(LineObj point / StartPoint EndPoint result)<br /> <br />    (setq StartPoint (vla-get-StartPoint LineObj))<br />    (setq EndPoint   (vla-get-EndPoint   LineObj))<br />   <br />    (setq point     (vlax-safearray->list(vlax-variant-value point     )))  <br />    (setq StartPoint(vlax-safearray->list(vlax-variant-value StartPoint))) <br />    (setq EndPoint  (vlax-safearray->list(vlax-variant-value EndPoint  )))<br />         <br />    ( if (or (equal StartPoint point 0.01 )<br />             (equal EndPoint   point 0.01))<br />            <br />       (setq result nil)<br />       (setq result T)<br />      )<br /> <br />   result<br /> )<br /> <br /> ;给直线上交点排序，要不会重叠的，效率太底，希望高手有好方法。<br /> ;说明我的算法，1、判断直线是否垂直，如果垂直由Y来排序；如果不垂直用X来排序。<br /> ;              2、确定StartPoint中X或Y值是否为最大值，来确定排序是选取最大还是最小。<br /> ;              3、选出一个生成一个直线。<br /> ;<br /> ;真是狂晕，真是太慢了 <br /> <br /> ( defun LinePointOrder( lineCol / num line n i j tmp tmpLine StartPoint EndPoint<br />                                    on this L)<br /> <br />   (setq num 0)<br /> <br />   (repeat (vl-list-length lineCol)            ;根据直线多少来确定次数<br />   <br />     (setq line (nth num lineCol ))                   ;应该递增<br />     <br />     (setq tmpLine (list))<br />     (setq j 1)<br />     (setq n (vl-list-length line))             ;根据直线上的点确定次数<br />     <br />     (repeat n<br /> <br />       (setq tmp (nth (- n j) line))<br />       (setq tmp(vlax-safearray->list(vlax-variant-value tmp)))<br />       (setq tmpLine (cons tmp tmpLine))<br />       (setq j (1+ j))<br />     )<br />     (setq line tmpLine)<br />               <br />     (setq  StartPoint(nth  0     line))<br />     (setq  EndPoint  (nth (1- n) line))<br />     (setq  ls  (vlax-3d-point StartPoint))          ;保存直线最开始点<br /> <br />     (if (equal (car StartPoint) (car EndPoint) 0.0005)   ;判断直线是否为90度<br /> <br />        (progn<br />                                                         ;利用Y值来确定，线段交点顺序。          <br />           (setq tmp(nth 1 line))<br />          <br />           (setq on(> (cadr StartPoint) (cadr tmp)))    ;判断StartPoint是否为最大值<br />                              <br />           (repeat  (1- n)            <br />                              <br />             (setq this (nth 1 line))<br />             (setq tmp this)          <br />             (setq j 1)                       ;总是取第2个元素开始比较            <br />                <br />             (while tmp                       ;求出下一个线段结束点。               <br />                  <br />               (if on<br />                 (progn                                                          <br />                    (if (< (cadr this) (cadr tmp))                  ;求大的<br />                      (setq this tmp)<br />                    )<br />                  )<br />                 (progn                                                          <br />                   (if (> (cadr this) (cadr tmp))                  ;求小的<br />                     (setq this tmp)<br />                     )<br />                   )<br />                 )<br />               (setq j (1+ j))<br />               (setq tmp (nth j line))<br />             )<br />                 (setq line (vl-remove this line))           <br />                 (setq this(vlax-3d-point this))             ;转化为变体。<br />                 (setq L(vla-addLine mSpace ls this))        ;把破碎的直线重新连接起来               <br />                 (setq ls this)                       ;将下一个线段的开始点保存起来。<br />                 <br />           )<br />         )<br />       <br /> <br />         (progn<br />                                                         ;利用X值来确定，线段交点顺序。          <br />           (setq tmp(nth 1 line))<br />          <br />           (setq on(> (car StartPoint) (car tmp)))    ;判断StartPoint是否为最大值<br />                              <br />           (repeat  (1- n)           <br />                              <br />             (setq this (nth 1 line))<br />             (setq tmp this)          <br />             (setq j 1)                       ;总是取第2个元素开始比较            <br />                <br />             (while tmp                       ;求出下一个线段结束点。               <br />                  <br />               (if on<br />                 (progn                                                          <br />                    (if (< (car this) (car tmp))                  ;求大的<br />                      (setq this tmp)<br />                    )<br />                  )<br />                 (progn                                                          <br />                   (if (> (car this) (car tmp))                  ;求小的<br />                     (setq this tmp)<br />                     )<br />                   )<br />                 )<br />               (setq j (1+ j))<br />               (setq tmp (nth j line))<br />             )<br />                 (setq line (vl-remove this line))           <br />                 (setq this(vlax-3d-point this))             ;转化为变体。<br />                 (setq L(vla-addLine mSpace ls this))        ;把破碎的直线重新连接起来               <br />                 (setq ls this)                       ;将下一个线段的开始点保存起来。<br />                 <br />           )<br />         )<br />       )<br />     <br />     (setq num (1+ num))<br /> <br />   )<br />                        <br />    (setq s (getvar "DATE"))<br />    (setq seconds2 (* 86400.0 (- s (fix s))))         ;计算消耗时间<br />    (princ "\n打断消耗时间:")(princ (- seconds2 seconds1))(princ "秒")<br /> )