[LISP函数]：判断点在多边形的位置之完全版

zwx62504

;判断点在多边形的位置之完全版
根据本论坛上的相关的函数进行修改而成
[pcode=lisp,true]
;判断点在多边形的位置:内、外、线上
;返回值:内:1、外:-1、线上:0
;;方法1----射线法;
;;点是否在多边形内
;;点 P 是否在多边形 PM 内
;;If 'p' is in 'pm', return T.
;;'mx' is a very long distance.
(defun isInorOut (p pm / i p1 p2 tf tf1 tf2 px jp ret)
  (setq        px (list (+ 1e+100 (car p)) (cadr p))
        p1 (last pm)
        i -1
  )


  (while (and (not ret)
              (setq p2 (nth (setq i (1+ i)) pm))
         )
    (if        (setq jp (inters px p p1 p2))
      (if (equal (car jp) (car p) 0.0001)
        (setq ret t)
        (setq tf2 (if (> (cadr p1) (cadr p2)) 1 0)
              tf (if (= tf1 tf2) tf (not tf))
              tf1 tf2
        )
      )
      (setq tf1 nil)
    )
    (setq p1 p2)
  )

  (cond
    (ret 0)               ;线上
    (tf 1)                ;内
    (t -1)                ;外
  )
)


;;方法2---角度法
;;点是否在多边形内  
(defun ptinpm (pt lst / i p1 p2 an anl ret)
  (setq i -1 p1 (last lst))
  (while (and (not ret)
              (setq p2 (nth (setq i (1+ i)) lst))
         )
    (cond
      ((equal p2 pt 1e-4) (setq ret t))
      (t
        (setq an (- (angle pt p1) (angle pt p2)))
        (if (equal pi (abs an) 1e-4)
          (setq ret t)
          (setq anl (cons (rem an PI) anl))
        )
      )
    )
    (setq p1 p2)
  )
  (cond
    (ret 0)               ;线上;
    (t
      (if (equal PI (abs (apply '+ anl)) 1e-4)
        1                 ;内;
        -1                ;外;
      )
    )
  )
)
  

;测试

(DEFUN C:tt (/ Curve Pt lst a b c)
  (IF (SETQ Curve (CAR (ENTSEL "\n选择一条曲线:")))(progn
      (setq lst (MAPCAR (FUNCTION CDR)
                    (VL-REMOVE-IF (FUNCTION (LAMBDA (x) (/= 10 (CAR x)))) (entget Curve))
                )
      )
    (WHILE (SETQ Pt (GETPOINT "\n点取测试点:"))
      (setq pt (list (car pt) (cadr pt))
            c 1
      )

      (setq a (ptinpm Pt lst))
      (princ "\nxd-point_inm:")   (princ (cond ((= 0 a) "线上")
                                                            ((= 1 a) "内")
                                                            (t "外")))
      
      (setq a (xd-point_inm Pt lst))
      (princ "\nptinpm:") (princ (cond ((= 0 a) "线上")
                                                            ((= 1 a) "内")
                                                            (t "外")))
      
    )
  ))
  (PRINC)
)


[/pcode]

gufengyin

论坛上不是有了吗？

zwx62504

论坛上的相关判断函数未包含判断点是否在多边形线上
该函数同时判断点在多边形线的位置三种可能：
1. 点在内部；
2. 点在外部；
3. 点在线上。

GTJ116600

版主，经测试方法1----射线法的函数有问题，测试提示：
      invalid point: (1.0e+100 21.5163)
        方法2——函数没有考虑多段线弧度问题

GTJ116600

gufengyin 发表于 2007-5-13 17:16
论坛上不是有了吗？

您能提供论坛上这两种第一种方法的其它链接么

Lispboy

GTJ116600 发表于 2013-5-26 14:47
您能提供论坛上这两种第一种方法的其它链接么

函数库论坛里面有，好像就前几天，SCMTOOLS斑竹整理的。

GTJ116600

Lispboy 发表于 2013-5-26 14:49
函数库论坛里面有，好像就前几天，SCMTOOLS斑竹整理的。

SCMTOOLS斑竹整理的是“判断点在多边形的位置—角度法"
没有射线法，经测试该函数不支持有弧度的多段线（或多义线），对多边形没有问题。
http://bbs.xdcad.net/thread-667803-1-1.html

XDSoft

GTJ116600 发表于 2013-5-26 14:58
SCMTOOLS斑竹整理的是“判断点在多边形的位置—角度法"
没有射线法，经测试该函数不支持有弧度的多段 ...

看看这个帖子： http://www.xdcad.net/forum/forum.php?mod=redirect&goto=findpost&ptid=667514&pid=3446158

测试下看如何，论文中心有论文，也可以根据算法自己写下。

下载地址：晓东文库





下载地址：晓东文库

GTJ116600

老大就是给力，我好好研究研究

cable2004

源码是好东西

kkt123

我好好研究:(:(

weizx2000

不错，学习了