获取两个二维点表的所有交点(非vla-IntersectWith)

半边书生

1. (defun XD::list:Intpt_2lsts(lst1 lst2 typ / i j ii jj pt1 pt2 pt3 pt4 azi intpt interpt)
   
2.    (setq ii (length lst1))
   
3.    (setq jj (length lst2))
   
4.   ;延长lst1左侧
   
5.   (if (= (substr typ 1 1) "1")
   
6.     (progn
   
7.      (setq pt1 (nth 0 lst1))
   
8.      (setq pt2 (nth 1 lst1))
   
9.      (setq azi (angle pt1 pt2))
   
10.      (setq azi (+ pi azi))
    
11.      (setq lst1 (append (list (polar pt1 azi 10000) ) lst1 ))
    
12.     )
    
13.   )
    
14.   ;延长lst1右侧
    
15.   (if (= (substr typ 2 1) "1")
    
16.     (progn
    
17.      (setq pt1 (nth (1- ii) lst1))
    
18.      (setq pt2 (nth ii lst1))
    
19.      (setq azi (angle pt1 pt2))
    
20.      (setq lst1 (append lst1 (list (polar pt2 azi 10000) ) ))
    
21.     )
    
22.   )
    
23.   ;延长lst2左侧
    
24.   (if (= (substr typ 3 1) "1")
    
25.     (progn
    
26.      (setq pt3 (nth 0 lst2))
    
27.      (setq pt4 (nth 1 lst2))
    
28.      (setq azi (angle pt3 pt4))
    
29.      (setq azi (+ pi azi))
    
30.      (setq lst2 (append (list (polar pt3 azi 10000) ) lst2 ))
    
31.     )
    
32.   )
    
33.   ;延长lst2右侧
    
34.   (if (= (substr typ 4 1) "1")
    
35.     (progn
    
36.      (setq pt3 (nth (1- jj) lst2))
    
37.      (setq pt4 (nth jj lst2))
    
38.      (setq azi (angle pt3 pt4))
    
39.      (setq lst2 (append lst2 (list (polar pt4 azi 10000) ) ))
    
40.     )
    
41.   )
    
42.   ;计算交点坐标
    
43.    (setq ii (1- (length lst1)))
    
44.    (setq jj (1- (length lst2)))
    
45.    (setq intpt nil interpt nil i 0 )
    
46.    (while (< i ii)
    
47.      (setq pt1 (nth i lst1))
    
48.      (setq pt2 (nth (1+ i) lst1))
    
49.      (setq j 0)
    
50.      (while (< j jj)
    
51.        (setq pt3 (nth j lst2))
    
52.        (setq pt4 (nth (1+ j) lst2))
    
53.        (setq intpt (inters pt1 pt2 pt3 pt4 t) )
    
54.        (if (/= intpt nil)
    
55.            ;将交点坐标存入点表
    
56.            (setq interpt (append interpt (list intpt)))
    
57.        )
    
58.        (setq j (1+ j))
    
59.      )
    
60.      (setq i (1+ i))
    
61.    )
    
62. interpt
    
63. )
    

(defun XD::list:Intpt_2lsts(lst1 lst2 typ / i j ii jj pt1 pt2 pt3 pt4 azi intpt interpt)<br />    (setq ii (length lst1))<br />    (setq jj (length lst2))<br />   ;延长lst1左侧<br />   (if (= (substr typ 1 1) "1")<br />     (progn<br />      (setq pt1 (nth 0 lst1))<br />      (setq pt2 (nth 1 lst1))<br />      (setq azi (angle pt1 pt2))<br />      (setq azi (+ pi azi))<br />      (setq lst1 (append (list (polar pt1 azi 10000) ) lst1 ))<br />     )<br />   )<br />   ;延长lst1右侧<br />   (if (= (substr typ 2 1) "1")<br />     (progn<br />      (setq pt1 (nth (1- ii) lst1))<br />      (setq pt2 (nth ii lst1))<br />      (setq azi (angle pt1 pt2))<br />      (setq lst1 (append lst1 (list (polar pt2 azi 10000) ) ))<br />     )<br />   )<br />   ;延长lst2左侧<br />   (if (= (substr typ 3 1) "1")<br />     (progn<br />      (setq pt3 (nth 0 lst2))<br />      (setq pt4 (nth 1 lst2))<br />      (setq azi (angle pt3 pt4))<br />      (setq azi (+ pi azi))<br />      (setq lst2 (append (list (polar pt3 azi 10000) ) lst2 ))<br />     )<br />   )<br />   ;延长lst2右侧<br />   (if (= (substr typ 4 1) "1")<br />     (progn<br />      (setq pt3 (nth (1- jj) lst2))<br />      (setq pt4 (nth jj lst2))<br />      (setq azi (angle pt3 pt4))<br />      (setq lst2 (append lst2 (list (polar pt4 azi 10000) ) ))<br />     )<br />   )<br />   ;计算交点坐标<br />    (setq ii (1- (length lst1)))<br />    (setq jj (1- (length lst2)))<br />    (setq intpt nil interpt nil i 0 )<br />    (while (< i ii)<br />      (setq pt1 (nth i lst1))<br />      (setq pt2 (nth (1+ i) lst1))<br />      (setq j 0)<br />      (while (< j jj)<br />        (setq pt3 (nth j lst2))<br />        (setq pt4 (nth (1+ j) lst2))<br />        (setq intpt (inters pt1 pt2 pt3 pt4 t) )<br />        (if (/= intpt nil)<br />            ;将交点坐标存入点表<br />            (setq interpt (append interpt (list intpt)))<br />        )<br />        (setq j (1+ j))<br />      )<br />      (setq i (1+ i))<br />    )<br /> interpt<br /> )<br />

追风lisp

学习了,谢谢楼主