[LISP]求助-交点统计

henai

如何能自动统计出一个范围里所有线的交点个数呢，尤其是线很多的情况下
急需。thank

meflying

求出了所有交点，不是是否有些多余

2. 
   
3. (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
   
4.   (setq ax_ent_1 (vlax-ename->vla-object ent1)
   
5.         ax_ent_2 (vlax-ename->vla-object ent2)
   
6.   )
   
7.   (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
   
8.   (setq intpoints (vlax-variant-value intpoints))
   
9.   (setq i 0)
   
10.   (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
    
11.     (repeat (/ (+ 1
    
12.               (- (vlax-safearray-get-u-bound intpoints 1)
    
13.                  (vlax-safearray-get-l-bound intpoints 1)
    
14.               )
    
15.            )
    
16.            3
    
17.         )
    
18.       (setq points (append points (list (list
    
19.                       (vlax-safearray-get-element intpoints i)
    
20.                       (vlax-safearray-get-element intpoints (+ i 1))
    
21.                       (vlax-safearray-get-element intpoints (+ i 2))
    
22.                     )))
    
23.       )
    
24.       (setq i (+ 3 i))
    
25.     )
    
26.   )
    
27.   points
    
28. )
    
29. 
    
30. (defun c:main( / ss n i j ent1 ent2 points)
    
31.   (setq ss (ssget))
    
32.   (if ss
    
33.     (setq n (sslength ss))
    
34.   )
    
35.   (setq i 0 j 0)
    
36.   (while (< i n)
    
37.     (setq j (1+ i))
    
38.     (setq ent1 (ssname ss i))
    
39.     (while (< j n)
    
40.       (setq ent2 (ssname ss j))
    
41.       (setq points (append points (getinterpoint ent1 ent2)))
    
42.       (setq j (1+ j))
    
43.     )
    
44.     (setq i (1+ i))
    
45.   )
    
46.   (Princ points)
    
47.   (princ (strcat "\n共有交点" (itoa (length points)) "个"))
    
48.   (princ)
    
49. )
    

<br /> (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)<br />   (setq ax_ent_1 (vlax-ename->vla-object ent1)<br />         ax_ent_2 (vlax-ename->vla-object ent2)<br />   )<br />   (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))<br />   (setq intpoints (vlax-variant-value intpoints))<br />   (setq i 0)<br />   (if (> (vlax-safearray-get-u-bound intpoints 1) 0)<br />     (repeat (/ (+ 1<br />               (- (vlax-safearray-get-u-bound intpoints 1)<br />                  (vlax-safearray-get-l-bound intpoints 1)<br />               )<br />            )<br />            3<br />         )<br />       (setq points (append points (list (list<br />                       (vlax-safearray-get-element intpoints i)<br />                       (vlax-safearray-get-element intpoints (+ i 1))<br />                       (vlax-safearray-get-element intpoints (+ i 2))<br />                     )))<br />       )<br />       (setq i (+ 3 i))<br />     )<br />   )<br />   points<br /> )<br /> <br /> (defun c:main( / ss n i j ent1 ent2 points)<br />   (setq ss (ssget))<br />   (if ss<br />     (setq n (sslength ss))<br />   )<br />   (setq i 0 j 0)<br />   (while (< i n)<br />     (setq j (1+ i))<br />     (setq ent1 (ssname ss i))<br />     (while (< j n)<br />       (setq ent2 (ssname ss j))<br />       (setq points (append points (getinterpoint ent1 ent2)))<br />       (setq j (1+ j))<br />     )<br />     (setq i (1+ i))<br />   )<br />   (Princ points)<br />   (princ (strcat "\n共有交点" (itoa (length points)) "个"))<br />   (princ)<br /> )<br />

henai

谢谢提供程序，不过在试用的时候好象出了点问题，算不出来
Command: main

Select objects: Other corner: 6 found

Select objects:
error: null function
(VLAX-ENAME->VLA-OBJECT ENT1)
(SETQ AX_ENT_1 (VLAX-ENAME->VLA-OBJECT ENT1) AX_ENT_2 (VLAX-ENAME->VLA-OBJECT
ENT2))
(GETINTERPOINT ENT1 ENT2)
(APPEND POINTS (GETINTERPOINT ENT1 ENT2))
(SETQ POINTS (APPEND POINTS (GETINTERPOINT ENT1 ENT2)))
(WHILE (< J N) (SETQ ENT2 (SSNAME SS J)) (SETQ POINTS (APPEND POINTS
(GETINTERPOINT ENT1 ENT2))) (SETQ J (1+ J)))
(WHILE (< I N) (SETQ J (1+ I)) (SETQ ENT1 (SSNAME SS I)) (WHILE (< J N) (SETQ
ENT2 (SSNAME SS J)) (SETQ POINTS (APPEND POINTS (GETINTERPOINT ENT1 ENT2)))
(SETQ J (1+ J))) (SETQ I (1+ I)))
(C:MAIN)
*Cancel*
不知道该如何解决，希望帮助 thank

tukuitk

先运行(vl-load-com)

meflying

henai发表于2003-11-7 15:22:00谢谢提供程序，不过在试用的时候好象出了点问题，算不出来
Command: main

Select objects: Other corner: 6 found

Select objects:
error: null function
(VLAX-ENAME->VLA-OBJE

你的好象是R14吧，这个程序用不了，说说你的线都是什么类型，如果都是LINE或PLINE的话还好办

henai

都是line,只是想知道有多少个交点，这样可以知道要布多少管
另外问一下 刚才的2002下还能用呀？

henai

2002下可以用使用，thank

meflying

R14可用程序

2. 
   
3. 
   
4. (defun Getinterpoints(ent1 ent2 / e1 e2 pt1 pt2 pt3 pt4)
   
5.   (setq e1 (entget ent1))
   
6.   (setq e2 (entget ent2))
   
7.   (setq pt1 (cdr (assoc 10 e1)))
   
8.   (setq pt2 (cdr (assoc 11 e1)))
   
9.   (setq pt3 (cdr (assoc 10 e2)))
   
10.   (setq pt4 (cdr (assoc 11 e2)))
    
11.   (inters pt1 pt2 pt3 pt4)
    
12. )
    
13. 
    
14. (defun c:main( / ss n i j ent1 ent2 points point)
    
15.   (setq ss (ssget '((0 . "line"))))
    
16.   (if ss
    
17.     (setq n (sslength ss))
    
18.   )
    
19.   (setq i 0 j 0)
    
20.   (while (< i n)
    
21.     (setq j (1+ i))
    
22.     (setq ent1 (ssname ss i))
    
23.     (while (< j n)
    
24.       (setq ent2 (ssname ss j))
    
25.       (if (setq point (getinterpoints ent1 ent2))
    
26.         (setq points (append points (list point)))
    
27.       )
    
28.       (setq j (1+ j))
    
29.     )
    
30.     (setq i (1+ i))
    
31.   )
    
32.   (Princ points)
    
33.   (princ (strcat "\n共有交点" (itoa (length points)) "个"))
    
34.   (princ)
    
35. )
    
36. 
    

<br /> <br /> (defun Getinterpoints(ent1 ent2 / e1 e2 pt1 pt2 pt3 pt4)<br />   (setq e1 (entget ent1))<br />   (setq e2 (entget ent2))<br />   (setq pt1 (cdr (assoc 10 e1)))<br />   (setq pt2 (cdr (assoc 11 e1)))<br />   (setq pt3 (cdr (assoc 10 e2)))<br />   (setq pt4 (cdr (assoc 11 e2)))<br />   (inters pt1 pt2 pt3 pt4)<br /> )<br /> <br /> (defun c:main( / ss n i j ent1 ent2 points point)<br />   (setq ss (ssget '((0 . "line"))))<br />   (if ss<br />     (setq n (sslength ss))<br />   )<br />   (setq i 0 j 0)<br />   (while (< i n)<br />     (setq j (1+ i))<br />     (setq ent1 (ssname ss i))<br />     (while (< j n)<br />       (setq ent2 (ssname ss j))<br />       (if (setq point (getinterpoints ent1 ent2))<br />         (setq points (append points (list point)))<br />       )<br />       (setq j (1+ j))<br />     )<br />     (setq i (1+ i))<br />   )<br />   (Princ points)<br />   (princ (strcat "\n共有交点" (itoa (length points)) "个"))<br />   (princ)<br /> )<br /> <br />