判断点是否在(凹凸皆可)多边型内(无内部孤岛)

long9841

;;lst,坐标列表 pt坐标点,多边形不能有圆弧段
(if (member "geomcal" (arx))nil (arxload "geomcal"))

(defun       AngForPolygon (pt lst / pt lst p1 p2 ang i)
   (if (member (list(car pt)(cadr pt)) lst)
      t
      (progn (setq   ang   0.0
                      i   0
                    nn  (length lst)
                   jaj 0.0   ) ;_ setq
             (while (and (/= 180.0 jaj) (> nn i))
                (setq p1  (nth i lst)
                      p2  (nth (rem (1+ i) nn) lst)
                      jaj (cal "ang(pt,p1,p2)")
                      jaj (if (> jaj 180.0)
                             (- jaj 360.0)
                             jaj
                          ) ;_ if
                      ang (+ ang jaj)
                      i   (1+ i)
                )         )
             (if (= 180.0 jaj)
                t
                (if (equal (abs ang) 360.0 1e-9)
                   t
                ) ;_ if
             ) ;_ if
      ) ;_ progn
   ) ;_ if
)

mandala

;;By Xiao_longxin 明经通道
;;有一不规则多边形由点a1(x1,y1)、a2(x2,y2).....an(xn,yn)依次连接而成，如何求证点p(x,y)是在多边形内还是多边形外？
;;将直线PAi记作ki.将ki旋转到ki+1(令kn+1=k1)的角记为βi(规定逆时针为正，顺时针为负,如果βi大于180就变成βi－360)。
;;从直观上看有下面的结论
;;若P在形内，诸β的代数和为360度；
;;若P在形外，诸β的代数和为0。

;;pt_list 为((x y z) (x y z)......(x y z))即围成多边形的表
;;pt 为要判断的点
;;自相交多边形适用，不适用于曲线
(defun inorout (pt_list pt / e1 pt n i j va va_count)
  (setq        i         0
        va_count 0
        n         (length pt_list)
        pt_list         (append pt_list (list (car pt_list)))
  )
  (repeat n
    (setq va (-        (angle pt (nth i pt_list))
                (angle pt (nth (1+ i) pt_list))
             )
    )
    (cond ((> va pi) (setq va (- va pi)))
          ((< va (* -1 pi)) (setq va (+ va pi)))
    )
    (setq va_count (+ va_count va)
          i           (1+ i)
    )
  )
  (if (< (abs (- (abs va_count) pi)) 0.000001)
    't
    'nil
  )
)

;;另一种算法
;;By Longxin 明经通道 2006.04
;;;;;判断一点是否在一个封闭的区域内，支持曲线(pline拟合、spline、圆、椭圆)
;;算法：设曲线为逆时针
;;如果一点p在封闭曲线内，则过点p的曲线的法线与曲线交于p',可得法线方位角p-p'=ang1
;;求得p'点在曲线上的切线p'-p1，方位角为ang2
;;则法线与切线的方位角之差为：pi/2
;;依此方法，可求得在封闭曲线内的点
;;参数：ename,曲线图无名
;;      pt，三维点
;;返回：t---pt点在曲线内
;;      nil--pt点在曲线上或者外
(defun inorout_s (ename pt / obj ptnear parm yspt1 yspt2 ang1 ang2)
  ;;(command "point" pt)
  (setq        obj    (vlax-ename->vla-object ename)
        ptnear (vlax-curve-getClosestPointTo obj pt)
                                        ;取得点到曲线的最近点
  )
  ;;(command "point" ptnear)
  (setq        ang1  (angle ptnear pt)                ;最近点在曲线上的法线方位角
        parm  (vlax-curve-getParamAtPoint obj ptnear)
                                        ;最近点在曲线上的参数
        yspt1 (vlax-curve-getFirstDeriv obj parm)
                                        ;取得该点的第一衍生,即切线的衍生方向增量
        yspt1 (list (+ (nth 0 ptnear) (nth 0 yspt1))
                    (+ (nth 1 ptnear) (nth 1 yspt1))
                    (nth 2 ptnear)
              )
        ang2  (angle ptnear yspt1)        ;最近点在曲线上的切线方位角
        ang1  (- ang1 ang2)
  )
  (if (< ang1 0)
    (setq ang1 (+ (* 2 pi) ang1))        ;使值恒为正
  )
  ;;(print ang1)
  ;;(if (PlineCCW_obj ename)
  ;;(print "\n逆")
  ;;(print "\n顺")
  ;;)
  (if (PlineCCW_obj ename)                ;判断曲线的顺、逆
    (if        (< ang1 pi)
      t                                        ;如果曲线为逆时针，且法线与切线角度之差小于180度
      nil                                ;如果曲线为逆时针，且法线与切线角度之差大于180度
    )
    (if        (< ang1 pi)
      nil                                ;如果曲线不为逆时针，且法线与切线角度之差小于180度
      t                                        ;如果曲线不为逆时针，且法线与切线角度之差大于180度
    )
  )
)

long9841

楼上的算法很不错

chlh_jd

2. 
   
3. ;;;判断点是否在封闭多边形内 .
   
4. ;;;Function : judge a point location with polygon
   
5. ;;;Arg : pt -- a point
   
6. ;;;      pts -- points of polygon
   
7. ;;;      eps -- allowance
   
8. ;;;return :
   
9. ;;;     -1 -- out of polygon , 0 -- at , 1 -- in
   
10. (defun pipl?(pt pts eps / is at a)
    
11.   ;; by 狂刀  
    
12. ;; Edit by GSLS(SS) 2011.03.28
    
13.    (setq pt(trans pt 0 0)pts(mapcar(function(lambda(x)(trans x 0 0)))pts)Eps(abs Eps))
    
14.   (if(equalmember pt pts eps)0
    
15.     (progn(setq is(equal PI (abs(apply(function +)(mapcar(function(lambda (x y / a)
    
16.         (setq a (rem (- (angle pt x) (angle pt y)) PI))
    
17.                 (if(equal (+(distance pt x)(distance pt y))(distance x y)Eps)(setq at T))a))
    
18.                    (cons (last pts) pts) pts))) eps))(cond (at 0)(is 1)(T -1)))))
    
19. (defun equalmember (e lst tor)
    
20.   (apply (function or)
    
21.          (mapcar (function (lambda (x) (equal x e tor))) lst)
    
22.   )
    
23. )

<br /> ;;;判断点是否在封闭多边形内 .<br /> ;;;Function : judge a point location with polygon<br /> ;;;Arg : pt -- a point<br /> ;;;      pts -- points of polygon<br /> ;;;      eps -- allowance<br /> ;;;return :<br /> ;;;     -1 -- out of polygon , 0 -- at , 1 -- in<br /> (defun pipl?(pt pts eps / is at a)<br />   ;; by 狂刀  <br /> ;; Edit by GSLS(SS) 2011.03.28<br />    (setq pt(trans pt 0 0)pts(mapcar(function(lambda(x)(trans x 0 0)))pts)Eps(abs Eps))<br />   (if(equalmember pt pts eps)0<br />     (progn(setq is(equal PI (abs(apply(function +)(mapcar(function(lambda (x y / a)<br />         (setq a (rem (- (angle pt x) (angle pt y)) PI))<br />                 (if(equal (+(distance pt x)(distance pt y))(distance x y)Eps)(setq at T))a))<br />                    (cons (last pts) pts) pts))) eps))(cond (at 0)(is 1)(T -1)))))<br /> (defun equalmember (e lst tor)<br />   (apply (function or)<br />          (mapcar (function (lambda (x) (equal x e tor))) lst)<br />   )<br /> )

chlh_jd

测试方法

2. (defun c:t1(/ pts pt res)
   
3.   (setq pts (ss-assoc 10 (entget (car (entsel)))))
   
4.   (while (setq pt (getpoint))
   
5.     (setq res (pipl? pt pts 1e-2))
   
6.     (cond ((= res 1) (alert "In")) ((= res 0) (alert "At"))((= res -1)(alert "Out"))))(princ))
   
7. (defun ss-assoc        (a lst / b res)
   
8.   (while (setq b (assoc a lst))
   
9.     (setq lst  (cdr (member b lst))
   
10.           res (cons (cdr b) res)
    
11.     ))(reverse res))

(defun c:t1(/ pts pt res)<br />   (setq pts (ss-assoc 10 (entget (car (entsel)))))<br />   (while (setq pt (getpoint))<br />     (setq res (pipl? pt pts 1e-2))<br />     (cond ((= res 1) (alert "In")) ((= res 0) (alert "At"))((= res -1)(alert "Out"))))(princ))<br /> (defun ss-assoc        (a lst / b res)<br />   (while (setq b (assoc a lst))<br />     (setq lst  (cdr (member b lst))<br />           res (cons (cdr b) res)<br />     ))(reverse res))

lisp爱好者

学习了，

xiabin68

学习了，，好算法，，，