判断点在多边形的位置之完全版

;判断点在多边形的位置:内、外、线上
;返回值:内: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)
)