[LISP函数]：一个求交点函数的问题

winabcd

以下函数是我从论坛中找到的， 用了多时，没有问题，可今天却出了点麻烦，
这里是函数

2. 
   
3. (defun tt( / ent1 ent2 lst1 pt )
   
4.    (setq ent1 (car (entsel "选择曲线1：")))
   
5.    (setq ent2 (car (entsel "选择曲线2：")))
   
6.    (print (setq lst1 (GetInterPoint ent1 ent2)))
   
7.    (command "_pline")
   
8.    (while (setq pt (car lst1))
   
9.       (command pt)
   
10.       (setq lst1 (cdr lst1))
    
11.       )
    
12.    (command "C")
    
13.    (princ)
    
14.    )
    
15. 
    
16. (defun GetInterPoint ( ent1 ent2 / ax_ent_1 ax_ent_2 intpoints j disp)
    
17.    (setq ax_ent_1 (vlax-ename->vla-object ent1)
    
18.          ax_ent_2 (vlax-ename->vla-object ent2)
    
19.    )
    
20.    (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
    
21.    (setq intpoints (vlax-variant-value intpoints))
    
22.    (setq disp nil)
    
23.    (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
    
24.       (progn
    
25.          (setq j 0)
    
26.          (repeat
    
27.            (/ (+ 1
    
28.               (- (vlax-safearray-get-u-bound intpoints 1)
    
29.                  (vlax-safearray-get-l-bound intpoints 1)
    
30.               )
    
31.               )
    
32.               3
    
33.            )
    
34.            (setq disp (cons (list (vlax-safearray-get-element intpoints j)
    
35.                                (vlax-safearray-get-element intpoints (+ 1 j))
    
36.                                (vlax-safearray-get-element intpoints (+ 2 j)))
    
37.                          disp);cons
    
38.               j (+ j 3)
    
39.            )
    
40.          );repeat
    
41.          ;(princ disp)
    
42.       );progn
    
43.       ;(princ "\n两曲线没有交点")
    
44.    );if
    
45.   disp
    
46. )

<br /> (defun tt( / ent1 ent2 lst1 pt )<br />    (setq ent1 (car (entsel "选择曲线1：")))<br />    (setq ent2 (car (entsel "选择曲线2：")))<br />    (print (setq lst1 (GetInterPoint ent1 ent2)))<br />    (command "_pline")<br />    (while (setq pt (car lst1))<br />       (command pt)<br />       (setq lst1 (cdr lst1))<br />       )<br />    (command "C")<br />    (princ)<br />    )<br /> <br /> (defun GetInterPoint ( ent1 ent2 / ax_ent_1 ax_ent_2 intpoints j disp)<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 disp nil)<br />    (if (> (vlax-safearray-get-u-bound intpoints 1) 0)<br />       (progn<br />          (setq j 0)<br />          (repeat<br />            (/ (+ 1<br />               (- (vlax-safearray-get-u-bound intpoints 1)<br />                  (vlax-safearray-get-l-bound intpoints 1)<br />               )<br />               )<br />               3<br />            )<br />            (setq disp (cons (list (vlax-safearray-get-element intpoints j)<br />                                (vlax-safearray-get-element intpoints (+ 1 j))<br />                                (vlax-safearray-get-element intpoints (+ 2 j)))<br />                          disp);cons<br />               j (+ j 3)<br />            )<br />          );repeat<br />          ;(princ disp)<br />       );progn<br />       ;(princ "\n两曲线没有交点")<br />    );if<br />   disp<br /> )

下面是求出的交点
((59118.6 635315.0 0.0) (59198.6 635350.0 0.0) (59144.2 635351.0 0.0) (59144.2
635351.0 0.0) (59195.9 635351.0 0.0))
你再看看图形（图在附件中，解压后为一DWG图形）
（图中红线是用所求的交点画出来的，要注意的是，你把红色圆的圆心处放大、放大、再放大，就能看出问题了）

明明是四个义点，却求出五个来。
真搞不明白？。。。。

xyp1964

((59118.6 635315.0 0.0) (59198.6 635350.0 0.0) (59144.2 635351.0 0.0) (59144.2 635351.0 0.0) (59195.9 635351.0 0.0))
正常！3、4点为重复点！

winabcd

楼上的斑竹，图形的交点明明只有四个，为什么会求出五个呢？
我传上来的图形是经过删剪的，原图中有许多线，是地形线，当我用一个矩形去切这些地形线时，所求出的交点大部分是正确的，可是总有几个求出来的有重复点，而且当矩形的位置有变化时，出现重复点的线条也会变化。
斑竹能不能说说出现这种情况的原因。

小菜

vla-intersectwith有些问题是无法预计的，我已经遇到几次类似的情况了，楼上这种情况可以在求出交点后再去除重复项。

winabcd

楼上的，上面显示的3、4两项虽然一样，可实际不完全一样，那是因为显示时只显示了小数后一位，实际是：
(59118.57055237 635314.92479259 0)
(59198.56200259 635349.54895191 0)
(59144.19868994 635351.32391003 0)
(59144.19877101 635351.32391003 0)
(59195.89768931 635351.32391003 0)
我真的去找相同项，可又找不到了。