判断点在封闭曲线内，跟随黄总的步伐

dtucad · 发表于 2024-4-3 23:34

本帖最后由 dtucad 于 2024-4-3 23:37 编辑

http://bbs.mjtd.com/thread-189728-1-1.html
跟随黄总的步伐，也来两个判断点在封闭曲线内的函数，水平有限，如有错误请反馈

;第一种
;判断点是否在非自交多边形内，使用射线交叉法，从要测试的点向任意方向引一条射线，统计射线与多边形边界的交点数量。如果交点数目是奇数，则点位于多边形内部；如果是偶数，则点位于多边形外部。如果交点为多边形顶点可能无法正确判断，此时旋转射线重新判断。
;参数：pt判断的点、pts多边形点表、fz误差
;返回：1在内部、0在线上、-1在外部
(defun JudPtinPts (pt pts fz / box d i inter k line lines lines-tmp memberfz ray)
(defun MemberFz (pt lst fz);带误差的member
(vl-some (function (lambda(x) (equal pt x fz))) lst)
)
(setq lines (mapcar (function list) pts (append (cdr pts) (list (car pts)))))
(if (vl-some ;判断点在线上
(function (lambda (x / ang1 ang2 p1 p2)
(setq p1 (car x))
(setq p2 (cadr x))
(or
(or
(equal pt p1 fz)
(equal pt p2 fz)
)
(and
(setq ang1 (angle p1 pt))
(setq ang2 (angle pt p2))
(or (equal ang1 ang2 1e-6)
(equal (abs (- ang1 ang2)) (* pi 2) 1e-6)
)
)
)
)
)
lines
)
0;在线上
(progn;判断交点数量
(setq box (mapcar (function (lambda (a b) (apply (function mapcar) (cons a b)))) '(min max) (list pts pts)))
(setq d (+ (apply 'distance box) (distance pt (car pts))))
(setq ray (list pt (polar pt 0 d)));虚拟一条足够长的射线
(setq lines-tmp lines)
(setq i 0 k 0)
(while (and lines-tmp (< k 360))
(setq line (car lines-tmp))
(setq lines-tmp (cdr lines-tmp))
(if (setq inter (apply 'inters (append ray line)));有交点
(if (not (MemberFz inter pts fz));且交点不为顶点
(setq i (1+ i));交点数量
(setq i 0;归零
k (1+ k)
ray (list pt (polar pt (* (/ pi 180) k) d));射线旋转1°
lines-tmp lines;重新判断
)
)
)
)
(cond
((zerop (rem i 2)) -1);偶数个交点，在线外
(t 1);奇数，在线内
)
)
)
)

;第一种 
;判断点是否在非自交多边形内，使用射线交叉法，从要测试的点向任意方向引一条射线，统计射线与多边形边界的交点数量。如果交点数目是奇数，则点位于多边形内部；如果是偶数，则点位于多边形外部。如果交点为多边形顶点可能无法正确判断，此时旋转射线重新判断。 
;参数：pt判断的点、pts多边形点表、fz误差 
;返回：1在内部、0在线上、-1在外部 
(defun JudPtinPts (pt pts fz / box d i inter k line lines lines-tmp memberfz ray) 
  (defun MemberFz (pt lst fz);带误差的member 
    (vl-some (function (lambda(x) (equal pt x fz))) lst) 
  ) 
   
  (setq lines (mapcar (function list) pts (append (cdr pts) (list (car pts))))) 
  (if (vl-some ;判断点在线上 
        (function (lambda (x / ang1 ang2 p1 p2) 
                    (setq p1 (car x)) 
                    (setq p2 (cadr x)) 
                    (or 
                      (or 
                        (equal pt p1 fz) 
                        (equal pt p2 fz) 
                      ) 
                      (and 
                        (setq ang1 (angle p1 pt)) 
                        (setq ang2 (angle pt p2)) 
                        (or (equal ang1 ang2 1e-6) 
                          (equal (abs (- ang1 ang2)) (* pi 2) 1e-6) 
                        ) 
                      ) 
                    ) 
                  ) 
        ) 
        lines 
      ) 
    0;在线上 
    (progn;判断交点数量 
      (setq box (mapcar (function (lambda (a b) (apply (function mapcar) (cons a b)))) '(min max) (list pts pts))) 
      (setq d (+ (apply 'distance box) (distance pt (car pts)))) 
      (setq ray (list pt (polar pt 0 d)));虚拟一条足够长的射线 
      (setq lines-tmp lines) 
      (setq i 0 k 0) 
      (while (and lines-tmp (< k 360)) 
        (setq line (car lines-tmp)) 
        (setq lines-tmp (cdr lines-tmp)) 
        (if (setq inter (apply 'inters (append ray line)));有交点 
          (if (not (MemberFz inter pts fz));且交点不为顶点 
            (setq i (1+ i));交点数量 
            (setq i 0;归零 
              k (1+ k) 
              ray (list pt (polar pt (* (/ pi 180) k) d));射线旋转1° 
              lines-tmp lines;重新判断 
            ) 
          ) 
        ) 
      ) 
      (cond 
        ((zerop (rem i 2)) -1);偶数个交点，在线外 
        (t 1);奇数，在线内 
      ) 
    ) 
  ) 
)

;第二种
;判断点是否在封闭曲线内，生成图元射线找与封闭曲线交点(判断原理同上)，支持多段线、圆、椭圆、样条曲线等封闭曲线
;参数：pt判断的点、e曲线图元名、fz误差
;返回：1在内部、0在线上、-1在外部
(defun JudPtinCurr (pt e fz / *error* ang cp ed getinter i islock isvertex its k la layobj list->3pair loop mkray obj-cur obj-ray ray vlay)
;错误处理
(defun *error* (msg)
(if (not (vlax-erased-p obj-ray))
(vla-Delete obj-ray)
)
(princ msg)
)
;表转3D点表
(defun list->3pair (old / new)
(while (setq new (cons (list (car old) (cadr old) (caddr old)) new) old (cdddr old)))
(reverse new)
)
;找2个对象的交点不延长返回：交点列表
(defun getinter (obj1 obj2 / inter iplist re)
(if (not (vl-catch-all-error-p
(setq iplist (vl-catch-all-apply 'vlax-safearray->list
(list (vlax-variant-value (vla-intersectwith obj1 obj2 acextendnone)))
))))
(list->3pair iplist)
)
)
;判断交点是否为曲线顶点或在射线角度上的切点
(defun IsVertex (obj pt ang / ang-de de n name)
(if (and
(setq name (vla-get-ObjectName obj))
(setq n (vlax-curve-getParamAtPoint obj pt))
)
(if (and
(or
(= name "AcDbPolyline")
(= name "AcDb2dPolyline")
(= name "AcDb3dPolyline")
(= name "AcDbSpline")
)
(equal (fix n) n 1e-8)
)
t ;为顶点
(and ang
(setq de (vlax-curve-getFirstDeriv obj n))
(setq ang-de (angle '(0 0 0) de))
(or ;为切点
(equal ang-de ang 1e-8)
(equal ang-de (+ pi ang) 1e-8)
(equal ang-de (+ (* pi 2) ang) 1e-8)
)
)
)
)
)
;生成射线返回图元名
(defun MKRay (p1 p2)
(entmakeX
(list
'(0 . "RAY")
'(100 . "AcDbEntity")
'(100 . "AcDbRay")
(cons 10 p1)
(cons 11 (mapcar '- p2 p1))
)
)
)
(setq obj-cur (vlax-ename->vla-object e))
(if (and
(setq cp (vlax-curve-getClosestPointTo obj-cur pt))
(equal cp pt fz)
)
0;在线上
(progn
(if (and ;解锁当前图层
(setq la (getvar "CLAYER"))
(setq layobj (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))))
(setq vlay (vla-item layobj la))
)
(if (= (vla-get-lock vlay) :vlax-true)
(progn
(vla-put-lock vlay :vlax-false)
(setq islock t)
)
)
)
(setq ang 0)
(setq pt (trans pt 1 0))
(setq ray (MKRay pt (polar pt ang 10)))
(setq ed (entget ray))
(setq obj-ray (vlax-ename->vla-object ray))
(setq k 0 loop t)
(while (and loop (< k 360))
(if (setq its (getinter obj-cur obj-ray));有交点
(progn
(if (vl-every (function (lambda(p) (not (IsVertex obj-cur p ang)))) its)
(setq i (length its);交点数量
loop nil
)
(progn;交点为顶点或切点
(setq k (1+ k) ang (* (/ pi 180) k))
(entmod (subst (cons 11 (mapcar '- (polar pt ang 10) pt)) (assoc 11 ed) ed));射线旋转1°
)
)
)
(setq loop nil)
)
)
(if (not (vlax-erased-p obj-ray))
(vla-Delete obj-ray)
)
(if islock ;恢复锁定
(vla-put-lock vlay :vlax-true)
)
(cond
((or (not i)(zerop (rem i 2))) -1);偶数个交点，在线外
(t 1);奇数，在线内
)
)
)
)

;第二种 
;判断点是否在封闭曲线内，生成图元射线找与封闭曲线交点(判断原理同上)，支持多段线、圆、椭圆、样条曲线等封闭曲线 
;参数：pt判断的点、e曲线图元名、fz误差 
;返回：1在内部、0在线上、-1在外部 
(defun JudPtinCurr (pt e fz / *error* ang cp ed getinter i islock isvertex its k la layobj list->3pair loop mkray obj-cur obj-ray ray vlay) 
  ;错误处理 
  (defun *error* (msg) 
    (if (not (vlax-erased-p obj-ray)) 
      (vla-Delete obj-ray) 
    ) 
    (princ msg) 
  ) 
  ;表转3D点表 
  (defun list->3pair (old / new) 
    (while (setq new (cons (list (car old) (cadr old) (caddr old)) new) old (cdddr old))) 
    (reverse new) 
  ) 
  ;找2个对象的交点 不延长 返回：交点列表 
  (defun getinter (obj1 obj2 / inter iplist re) 
    (if (not (vl-catch-all-error-p 
               (setq iplist (vl-catch-all-apply 'vlax-safearray->list 
                              (list (vlax-variant-value (vla-intersectwith obj1 obj2 acextendnone))) 
                            )))) 
      (list->3pair iplist) 
    ) 
  ) 
  ;判断交点是否为曲线顶点或在射线角度上的切点 
  (defun IsVertex (obj pt ang / ang-de de n name) 
    (if (and 
          (setq name (vla-get-ObjectName obj)) 
          (setq n (vlax-curve-getParamAtPoint obj pt)) 
        ) 
      (if (and 
            (or 
              (= name "AcDbPolyline") 
              (= name "AcDb2dPolyline") 
              (= name "AcDb3dPolyline") 
              (= name "AcDbSpline") 
            ) 
            (equal (fix n) n 1e-8) 
          ) 
        t ;为顶点 
        (and ang 
          (setq de (vlax-curve-getFirstDeriv obj n)) 
          (setq ang-de (angle '(0 0 0) de)) 
          (or ;为切点 
            (equal ang-de ang 1e-8) 
            (equal ang-de (+ pi ang) 1e-8) 
            (equal ang-de (+ (* pi 2) ang) 1e-8) 
          ) 
        ) 
      ) 
    ) 
  ) 
  ;生成射线 返回图元名 
  (defun MKRay (p1 p2) 
    (entmakeX 
      (list 
        '(0 . "RAY") 
        '(100 . "AcDbEntity") 
        '(100 . "AcDbRay") 
        (cons 10 p1) 
        (cons 11 (mapcar '- p2 p1)) 
      ) 
    ) 
  ) 
   
  (setq obj-cur (vlax-ename->vla-object e)) 
  (if (and 
        (setq cp (vlax-curve-getClosestPointTo obj-cur pt)) 
        (equal cp pt fz) 
      ) 
    0;在线上 
    (progn 
      (if (and ;解锁当前图层 
            (setq la (getvar "CLAYER")) 
            (setq layobj (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object)))) 
            (setq vlay (vla-item layobj la)) 
          ) 
        (if (= (vla-get-lock vlay) :vlax-true) 
          (progn 
            (vla-put-lock vlay :vlax-false) 
            (setq islock t) 
          ) 
        ) 
      ) 
      (setq ang 0) 
      (setq pt (trans pt 1 0)) 
      (setq ray (MKRay pt (polar pt ang 10))) 
      (setq ed (entget ray)) 
      (setq obj-ray (vlax-ename->vla-object ray)) 
      (setq k 0 loop t) 
      (while (and loop (< k 360)) 
        (if (setq its (getinter obj-cur obj-ray));有交点 
          (progn 
            (if (vl-every (function (lambda(p) (not (IsVertex obj-cur p ang)))) its) 
              (setq i (length its);交点数量 
                loop nil 
              ) 
              (progn;交点为顶点或切点 
                (setq k (1+ k) ang (* (/ pi 180) k)) 
                (entmod (subst (cons 11 (mapcar '- (polar pt ang 10) pt)) (assoc 11 ed) ed));射线旋转1° 
              ) 
            ) 
          ) 
          (setq loop nil) 
        ) 
      ) 
      (if (not (vlax-erased-p obj-ray)) 
        (vla-Delete obj-ray) 
      ) 
      (if islock ;恢复锁定 
        (vla-put-lock vlay :vlax-true) 
      ) 
      (cond 
        ((or (not i)(zerop (rem i 2))) -1);偶数个交点，在线外 
        (t 1);奇数，在线内 
      ) 
    ) 
  ) 
)

xyp1964 · 发表于 2024-4-4 19:16

(defun xyp-PtInCurve (pt e fuzz / p1)
"xyp-PtInCurve 点是否在封闭曲线内 (xyp-PtInCurve pt点 e封闭曲线 fuzz容差)"
;; 1在内部;0在线上;-1在外部
(if (and (xyp-IsCurve e) (xyp-CurveIsClose e)(setq p1 (vlax-curve-getclosestpointto e pt)))
(cond ((equal (distance pt p1) 0 fuzz) 0)
((xyp-PtInPtn pt (xyp-CurveDivNum e 1000)) 1)
(t -1)
)
)
)

dtucad · 发表于 2024-4-3 23:38

;测试
(defun c:tt (/ en pt pts)
(and
(setq pt (getpoint))
(setq en (car (entsel "\n选闭合曲线")))
(setq pts (mapcar '(lambda (x) (trans (cdr x) 0 1)) (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget en))))
(princ "\n第一种（不支持弧线）：")
(princ (JudPtinPts pt pts 1e-6))
(princ "\n第二种（支持弧线）：")
(princ (JudPtinCurr pt en 1e-6))
)
(princ)
)

xujinhua · 发表于 2024-4-4 10:25

你的也很不错啊，谢谢啊

xyp1964 · 发表于 2024-4-4 15:01

(defun xyp-PtInPtn (p pt)
"xyp-PtInPtn 点在点集内 (xyp-PtInPtn p点 pt点集)"
(equal(abs(apply'+(mapcar'(lambda(x y)(rem(-(angle x p)(angle y p))pi))pt(cons(last pt)pt))))pi 1e-8)
)

dtucad · 发表于 2024-4-4 16:37

xyp1964 发表于 2024-4-4 15:01

院长的代码虽然短小精悍，但是功能比较单一，没法正确判断点在线上，没法判断带弧形的曲线，我以前也是用的类似的，鉴于场景需要，参考黄总的思路写了这个通杀的（上面的第二种函数），各种曲线都到碗里来，还可以自定义精度（可以把离线比较近的点视为在线上，特别适合那些画图不准确的）

czb203 · 发表于 2024-4-7 09:42

大师出手就是不一样

账号		自动登录	找回密码
密码			注册

[函数] 判断点在封闭曲线内，跟随黄总的步伐

评分

评分