直线交点上画圆 高手指点

yjr111

为何仅仅是直线？

ljpnb

把这句(setq ssint (ssget "f" (list pt10 pt11)))
改成(setq ssint (ssget "c"  pt10 pt11))

xianaihua

给你一个所有交点上画圆的程序：

2. ;所有交点上画圆
   
3. (setq *ModelSpace*
   
4.        (vla-get-ModelSpace
   
5.    (vla-get-ActiveDocument
   
6.      (vlax-get-acad-object)
   
7.    ) ;_ 结束vla-get-ActiveDocument
   
8.        ) ;_ end of vla-get-ModelSpace
   
9. ) ;_ end of setq
   
10. (defun c:test (/ ss)
    
11.   (vl-load-com)
    
12.   (if (setq ss (ssget))
    
13.     (foreach x (IntersectionsinSet ss)
    
14.       (vla-AddCircle *ModelSpace* (vlax-3d-point x) 10)
    
15.     ) ;_ 结束foreach
    
16.   ) ;_ 结束if
    
17.   (princ)
    
18. ) ;_ 结束defun
    
19. (defun IntersectionsinSet (ss / a b i j l)
    
20.   (setq i (sslength ss))
    
21.   (while (not (minusp (setq j (1- i)
    
22.           i (1- i)
    
23.           ) ;_ 结束setq
    
24.         ) ;_ 结束minusp
    
25.    ) ;_ 结束not
    
26.     (setq a (vlax-ename->vla-object (ssname ss i)))
    
27.     (while (not (minusp (setq j (1- j))))
    
28.       (setq b (vlax-ename->vla-object (ssname ss j))
    
29.       l (cons (GroupByNum (vlax-invoke a 'IntersectWith b acExtendNone) 3)
    
30.         l
    
31.         ) ;_ 结束cons
    
32.       ) ;_ 结束setq
    
33.     ) ;_ 结束while
    
34.   ) ;_ 结束while
    
35.   (apply 'append l)
    
36. ) ;_ 结束defun
    
37. (defun GroupByNum (l n / r)
    
38.   (if l
    
39.     (cons
    
40.       (reverse (repeat n
    
41.      (setq r (cons (car l) r)
    
42.            l (cdr l)
    
43.      ) ;_ 结束setq
    
44.      r
    
45.          ) ;_ 结束repeat
    
46.       ) ;_ 结束reverse
    
47.       (GroupByNum l n)
    
48.     ) ;_ 结束cons
    
49.   ) ;_ 结束if
    
50. ) ;_ 结束defun
    

;所有交点上画圆<br /> (setq *ModelSpace*<br />        (vla-get-ModelSpace<br />    (vla-get-ActiveDocument<br />      (vlax-get-acad-object)<br />    ) ;_ 结束vla-get-ActiveDocument<br />        ) ;_ end of vla-get-ModelSpace<br /> ) ;_ end of setq<br /> (defun c:test (/ ss)<br />   (vl-load-com)<br />   (if (setq ss (ssget))<br />     (foreach x (IntersectionsinSet ss)<br />       (vla-AddCircle *ModelSpace* (vlax-3d-point x) 10)<br />     ) ;_ 结束foreach<br />   ) ;_ 结束if<br />   (princ)<br /> ) ;_ 结束defun<br /> (defun IntersectionsinSet (ss / a b i j l)<br />   (setq i (sslength ss))<br />   (while (not (minusp (setq j (1- i)<br />           i (1- i)<br />           ) ;_ 结束setq<br />         ) ;_ 结束minusp<br />    ) ;_ 结束not<br />     (setq a (vlax-ename->vla-object (ssname ss i)))<br />     (while (not (minusp (setq j (1- j))))<br />       (setq b (vlax-ename->vla-object (ssname ss j))<br />       l (cons (GroupByNum (vlax-invoke a 'IntersectWith b acExtendNone) 3)<br />         l<br />         ) ;_ 结束cons<br />       ) ;_ 结束setq<br />     ) ;_ 结束while<br />   ) ;_ 结束while<br />   (apply 'append l)<br /> ) ;_ 结束defun<br /> (defun GroupByNum (l n / r)<br />   (if l<br />     (cons<br />       (reverse (repeat n<br />      (setq r (cons (car l) r)<br />            l (cdr l)<br />      ) ;_ 结束setq<br />      r<br />          ) ;_ 结束repeat<br />       ) ;_ 结束reverse<br />       (GroupByNum l n)<br />     ) ;_ 结束cons<br />   ) ;_ 结束if<br /> ) ;_ 结束defun<br />

你只需改动一下，只选直线

2. (setq ss (ssget '((0 . "line"))))
   

(setq ss (ssget '((0 . "line"))))<br />

yjr111

xianaihua 发表于 2011-11-20 08:13
给你一个所有交点上画圆的程序：

你只需改动一下，只选直线

intersectwith是有点问题的

xianaihua

对于自身相交的多段线，最好将其打断，否则，自身相交的交点会忽略

xingyun300

xianaihua 发表于 2011-11-20 08:13
给你一个所有交点上画圆的程序：

你只需改动一下，只选直线

还是你这个好，谢谢你呀