判断点在多边形点表组成的多段线上（新手版）

a117034423

1. (defun pntison (pnt2 pnts2  / pts0 pts1 xca xcb xa xb i gg p1 p3);判断点在线上
   
2.   (setq pts1
   
3.   (if (not (equal (car pnts2) (last pnts2) 1e-5))
   
4.    (reverse (cons (car pnts2) (reverse pnts2)))    ;点表闭合
   
5.    pnts2
   
6. ))
   
7.    (setq pts0   (mapcar 'list pts1 (cdr pts1));首尾组对
   
8.       )
   
9. (setq xca
   
10.   (mapcar
    
11.     '(lambda (x)
    
12.        (mapcar '- pnt2 (car x))
    
13.        )
    
14.     pts0
    
15.     ))
    
16. (setq xcb
    
17.   (mapcar
    
18.     '(lambda (x)
    
19.        (mapcar '- (cadr x) (car x))
    
20.        )
    
21.     pts0
    
22.     ))
    
23.   (setq i 0)
    
24.   (repeat (length xca)
    
25.     (setq xa (nth i xca)
    
26.           xb (nth i xcb)
    
27.           xx (- (* (car xa) (cadr xb)) (* (car xb) (cadr xa)))
    
28.           p1 (apply 'mapcar (cons 'min (nth i pts0)))
    
29.           p3 (apply 'mapcar (cons 'max (nth i pts0)))
    
30.           i (1+ i)
    
31.           )
    
32.   (if (and
    
33.           (equal xx 0 1e-5)
    
34.           (AND
    
35.           (or
    
36.           (< (CAR P1) (CAR pnt2) (CAR P3))
    
37.           (equal (CAR P1) (CAR pnt2) 1e-5)
    
38.           (equal (CAR P3) (CAR pnt2) 1e-5)
    
39.           )
    
40.           (or
    
41.           (< (CADR P1) (CADR pnt2) (CADR P3))
    
42.           (equal (CADR P1) (CADR pnt2) 1e-5)
    
43.           (equal (CADR P3) (CADR pnt2) 1e-5)
    
44.           )
    
45.           )
    
46.         )
    
47.       (setq gg (cons xx gg))
    
48.     )
    
49.     )
    
50.   (vl-some '(lambda (x)
    
51.                    (equal x 0 1e-5))
    
52.                 gg)
    
53.     )
    

(defun pntison (pnt2 pnts2  / pts0 pts1 xca xcb xa xb i gg p1 p3);判断点在线上<br />   (setq pts1 <br />   (if (not (equal (car pnts2) (last pnts2) 1e-5))<br />    (reverse (cons (car pnts2) (reverse pnts2)))    ;点表闭合<br />    pnts2<br /> ))<br />    (setq pts0   (mapcar 'list pts1 (cdr pts1));首尾组对<br />       )<br /> (setq xca<br />   (mapcar<br />     '(lambda (x)<br />        (mapcar '- pnt2 (car x))<br />        )<br />     pts0<br />     ))<br /> (setq xcb<br />   (mapcar<br />     '(lambda (x)<br />        (mapcar '- (cadr x) (car x))<br />        )<br />     pts0<br />     ))<br />   (setq i 0)<br />   (repeat (length xca)<br />     (setq xa (nth i xca)<br />           xb (nth i xcb)<br />           xx (- (* (car xa) (cadr xb)) (* (car xb) (cadr xa))) <br />           p1 (apply 'mapcar (cons 'min (nth i pts0)))<br />           p3 (apply 'mapcar (cons 'max (nth i pts0)))<br />           i (1+ i)<br />           )<br />   (if (and<br />           (equal xx 0 1e-5)<br />           (AND<br />           (or<br />           (< (CAR P1) (CAR pnt2) (CAR P3))<br />           (equal (CAR P1) (CAR pnt2) 1e-5)<br />           (equal (CAR P3) (CAR pnt2) 1e-5)<br />           )<br />           (or<br />           (< (CADR P1) (CADR pnt2) (CADR P3))<br />           (equal (CADR P1) (CADR pnt2) 1e-5)<br />           (equal (CADR P3) (CADR pnt2) 1e-5)<br />           )<br />           )<br />         )<br />       (setq gg (cons xx gg))<br />     )<br />     )<br />   (vl-some '(lambda (x)<br />                    (equal x 0 1e-5))<br />                 gg)<br />     )<br />

一到两个点表交叉互乘，琢磨半天也玩不转了
索性用了repeat了

a117034423

借鉴了牢固的手稿和XDAPI的源码，写完发出来，自己测试是没啥问题了

a117034423

目前凸凹多边形等分的所有子函数都已经收集完毕了，近日就应该可以见成果了

marting

a117034423 发表于 2020-12-22 16:33
目前凸凹多边形等分的所有子函数都已经收集完毕了，近日就应该可以见成果了

理解下 XDRX API

1. (defun _ison (pnt pts)
   
2.   (equal 0.0
   
3.          (distance pnt
   
4.                    (xdrx-getpropertyvalue pts "closestpointto" pnt t)
   
5.          ) 1e-5
   
6.   )
   
7. )
   

(defun _ison (pnt pts)<br />   (equal 0.0<br />          (distance pnt<br />                    (xdrx-getpropertyvalue pts "closestpointto" pnt t)<br />          ) 1e-5<br />   )<br /> )<br />

a117034423

好的 谢谢了 API居然可以这么简单

xk15c

学习借鉴，自我提高

yangjian001

做一个热心并受欢迎的人