获取多边形点表包含于另一个多边形点表的点（线内与线上都包含）

a117034423

1. (defun c:pntcir (pnts1 pnts2  / pts0 pts1 total an1 an2 dis dba dbb i);包含于点表内点获取函数
   
2. (setq pts1
   
3.   (if (not (equal (car pnts1) (last pnts1) 1e-5));点表闭合
   
4.    (reverse (cons (car pnts1) (reverse pnts1)))
   
5.    pnts1
   
6. ))     
   
7. (setq pts0 (mapcar 'list pts1 (cdr pts1));首尾组对
   
8.       total 0
   
9.       i 0
   
10.       dba nil
    
11.       dbb nil
    
12.       )
    
13. (repeat (length pnts2)
    
14. (setq ptn (nth i pnts2))
    
15. (mapcar
    
16.    '(lambda (x1)
    
17.       (setq an1 (abs (- (angle ptn (car x1)) (angle ptn (cadr x1)))))
    
18.       (setq total (+ total an1))
    
19.     )
    
20.    pts0
    
21. );线内点
    
22. (if (equal (- total pi pi) 0.0 1e-5)
    
23.    (setq dba (cons ptn dba))
    
24. )
    
25. (mapcar
    
26.    '(lambda (x2)
    
27.       (setq dis (+ (distance ptn (car x2)) (distance ptn (cadr x2))))
    
28.       (setq an2 (+ (abs (angle ptn (car x2))) (abs (angle ptn (cadr x2)))))
    
29.       (if (and
    
30.        (equal dis (distance (car x2) (cadr x2)) 1e-5)
    
31.        (equal an2 pi 1e-5)
    
32.        )
    
33.    (setq dbb (cons ptn dbb))
    
34. )
    
35.     )
    
36.    pts0
    
37. );线上点
    
38. (setq i (1+ i))
    
39.   )
    
40. (vl-remove nil (append dba dbb));返回线上线内点表
    
41.   )
    

(defun c:pntcir (pnts1 pnts2  / pts0 pts1 total an1 an2 dis dba dbb i);包含于点表内点获取函数<br /> (setq pts1 <br />   (if (not (equal (car pnts1) (last pnts1) 1e-5));点表闭合<br />    (reverse (cons (car pnts1) (reverse pnts1)))<br />    pnts1<br /> ))     <br /> (setq pts0 (mapcar 'list pts1 (cdr pts1));首尾组对<br />       total 0<br />       i 0<br />       dba nil<br />       dbb nil<br />       )<br /> (repeat (length pnts2)<br /> (setq ptn (nth i pnts2))<br /> (mapcar<br />    '(lambda (x1)<br />       (setq an1 (abs (- (angle ptn (car x1)) (angle ptn (cadr x1)))))<br />       (setq total (+ total an1))<br />     )<br />    pts0<br /> );线内点<br /> (if (equal (- total pi pi) 0.0 1e-5)<br />    (setq dba (cons ptn dba))<br /> ) <br /> (mapcar<br />    '(lambda (x2)<br />       (setq dis (+ (distance ptn (car x2)) (distance ptn (cadr x2))))<br />       (setq an2 (+ (abs (angle ptn (car x2))) (abs (angle ptn (cadr x2)))))<br />       (if (and<br />        (equal dis (distance (car x2) (cadr x2)) 1e-5)<br />        (equal an2 pi 1e-5)<br />        )<br />    (setq dbb (cons ptn dbb))<br /> ) <br />     )<br />    pts0<br /> );线上点<br /> (setq i (1+ i))<br />   )<br /> (vl-remove nil (append dba dbb));返回线上线内点表<br />   )<br />

先别看了 我自己先研究一下吧

newer

1. (defun c:tt ()
   
2.   (if (and (setq
   
3.              e1        (car
   
4.                   (xdrx-entsel "\n拾取多段线1<退出>:" '((0 . "*polyline")))
   
5.                 )
   
6.            )
   
7.            (setq
   
8.              e2        (car
   
9.                   (xdrx-entsel "\n拾取多段线2<退出>:" '((0 . "*polyline")))
   
10.                 )
    
11.            )
    
12.            (setq pts1 (xdrx-getpropertyvalue e1 "vertices"))
    
13.            (setq pts2 (xdrx-getpropertyvalue e2 "vertices"))
    
14.            (setq pts (xdrx-get-intersect pts1 pts2))
    
15.       )
    
16.     (progn
    
17.       (xdrx-polyline-make pts)
    
18.     )
    
19.   )
    
20. )

(defun c:tt ()<br />   (if (and (setq<br />              e1        (car<br />                   (xdrx-entsel "\n拾取多段线1<退出>:" '((0 . "*polyline")))<br />                 )<br />            )<br />            (setq<br />              e2        (car<br />                   (xdrx-entsel "\n拾取多段线2<退出>:" '((0 . "*polyline")))<br />                 )<br />            )<br />            (setq pts1 (xdrx-getpropertyvalue e1 "vertices"))<br />            (setq pts2 (xdrx-getpropertyvalue e2 "vertices"))<br />            (setq pts (xdrx-get-intersect pts1 pts2))<br />       )<br />     (progn<br />       (xdrx-polyline-make pts)<br />     )<br />   )<br /> )

1. (defun _get (pl1 pl2)
   
2.   (setq pts1 (xdrx-getpropertyvalue e1 "vertices"))
   
3.   (setq pts2 (xdrx-getpropertyvalue e2 "vertices"))
   
4.   (if (setq e (xdrx-get-intersect pts1 pts2))
   
5.     (setq pts (xdrx-getpropertyvalue e "vertices"))
   
6.   )
   
7.   (xdge::free e)
   
8.   pts
   
9. )
   
10. 
    

(defun _get (pl1 pl2)<br />   (setq pts1 (xdrx-getpropertyvalue e1 "vertices"))<br />   (setq pts2 (xdrx-getpropertyvalue e2 "vertices"))<br />   (if (setq e (xdrx-get-intersect pts1 pts2))<br />     (setq pts (xdrx-getpropertyvalue e "vertices"))<br />   )<br />   (xdge::free e)<br />   pts<br /> )<br /> <br />

a117034423

谢了老大，我学习下intersect

测完收工

感谢a117034423的分享

marting

1. (defun _inside (pts1 pts2)
   
2.   (vl-remove-if
   
3.     '(lambda (x)
   
4.        (not (or        (xdrx-point-isinside x pts1)
   
5.                 (xdrx-point-ison x pts1)
   
6.             )
   
7.        )
   
8.      )
   
9.     pts2
   
10.   )
    
11. )
    

(defun _inside (pts1 pts2)<br />   (vl-remove-if<br />     '(lambda (x)<br />        (not (or        (xdrx-point-isinside x pts1)<br />                 (xdrx-point-ison x pts1)<br />             )<br />        )<br />      )<br />     pts2<br />   )<br /> )<br />

a117034423

marting 发表于 2020-12-22 15:54

谢了谢了，感谢回复，快完成了 做好我贴上来