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

lishucheng96

;;说明:得到两个二维点表的交点
;;用非vla-IntersectWith方法不生成对象写的点表交点函数，可选多种延长方向，两点表都可以选择是否双向延长还是各自单向延长
;;参数:lst1:点表1
;;参数:lst2:点表2
;;参数:typ:延长类型（不区别大小写）："0000"或其他—两个都不延长;"0001"—延长点表2右侧两个点; "0010"—延长点表2左侧两个点； "0011"—延长点表2两侧两个点; "1000"—延长点表1左侧两个点; "0100"—延长点表1右侧两个点；"1100"—延长点表1两侧两个点;"1111"—延长点表1和点表2两侧两个点;
;;返回:符合条件的包括所有交点的二维点表
;;示例
  ;(setq lst1 (list (list 1492.5310 356.4799) (list 1693.9629 457.0300) (list 2085.9058 466.7216) (list 2281.2705 367.3829)))
        ;(setq lst2 (list (list 1567.8204 362.9696) (list 1667.2671  324.9823) (list 1980.3360 258.3527) (list 2205.2348 357.8477)))
        ;(setq typ "0011")
  ;(Intpt_2lsts lst1 lst2 typ)
  ;((1532.53 376.449) (2255.92 380.272))

1. (defun Intpt_2lsts(lst1 lst2 typ / 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 Intpt_2lsts(lst1 lst2 typ / 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 />

LIULISHENG

支持一下楼主大作

zj20190405

谢谢大哥

tm010111

不错，谢谢楼主，正好需要用到