判断：一个点在封闭曲线内

自贡黄明儒 发表于 2024-3-28 08:30:15

本帖最后由自贡黄明儒于 2024-3-28 08:34 编辑

判断：一个点在封闭曲线内
在acad中，使用bloy,效果不错，基本上是万能的。不仅仅是封闭曲线，任何选择集都可以。
但在bcad中就不行了。我按照老迈的办法，使用(command "_.boundary" "a" "i" "y" "b" "n" ss "" "" "non" p "")
效果不好，改为caoyin版主的办法，效果也不好
(defun HH_PtInCurve
(PT CURVE / GetInters OBJ MINPT MAXPT E PS LST X Y)
(defun GetInters (OBJ1 OBJ2 / PS LST)
   (setq PS (vla-intersectwith OBJ1 OBJ2 0)
   PS (vl-catch-all-apply
'vlax-safearray->list
(list (vlax-variant-value PS))
      )
   )
   (if (and PS (not (vl-catch-all-error-p PS)))
(while (setq LST (cons (list (car PS) (cadr PS)) LST)
      PS (cdddr PS)
      )
)
   )
   LST
)
(if(equal (vlax-curve-getClosestPointTo CURVE PT) PT 1E-6)
   0
   (progn
(setq OBJ (vlax-ename->vla-object CURVE))
(vla-getboundingbox OBJ 'MINPT 'MAXPT)
(mapcar'(lambda (X) (set X (vlax-safearray->list (eval X))))
'(MINPT MAXPT)
)
(entmake
(list'(0 . "LINE")
(list 10 (car MINPT) (cadr PT))
(list 11 (car MAXPT) (cadr PT))
'(60 . 1)
)
)
(setq E (entlast)
   LST1 (GetInters OBJ (vlax-ename->vla-object E))
)
(entdel E)
(if LST1
(setqLST1 (vl-remove-if
      '(lambda(X / PP A)
   (setqPP (vlax-curve-getParamAtPoint CURVE X)
   A(angle '(0 0)
         (vlax-curve-getFirstDeriv CURVE PP)
      )
   )
   (or (equal A 0 1E-6)
         (equal A PI 1E-6)
         (equal A (* PI 2) 1E-6)
         (equal (fix PP) PP 1E-6)
   )
   )
      LST1
      )
)
)
(entmake
(list'(0 . "LINE")
(list 10 (car PT) (cadr MAXPT))
(list 11 (car PT) (cadr MINPT))
'(60 . 0)
)
)
(setq E (entlast)
   LST2 (GetInters OBJ (vlax-ename->vla-object E))
)
(entdel E)
(if LST2
(setqLST2 (vl-remove-if
      '(lambda(X / PP A)
   (setqX(vlax-curve-getClosestPointTo CURVE X)
   PP (vlax-curve-getParamAtPoint CURVE X)
   A(angle (vlax-curve-getFirstDeriv CURVE PP)
         '(0 0)
      )
   )
   (or (equal A (/ PI 2) 1E-6)
         (equal A (* PI 1.5) 1E-6)
         (equal (fix PP) PP 1E-6)
   )
   )
      LST2
      )
)
)
(and
LST1
LST2
(progn (setq X (vl-sort-i (mapcar 'car (cons PT LST1)) '<)
      Y (length (member 0 X))
)
(and (zerop (rem Y 2)) (= (rem (- (length X) Y) 2) 1))
)
(progn (setq X (vl-sort-i (mapcar 'cadr (cons PT LST2)) '<)
      Y (length (member 0 X))
)
(and (zerop (rem Y 2)) (= (rem (- (length X) Y) 2) 1))
)
)
   )
)
)

找度娘，搜到结果如下
;;;1，如果该直线与封闭图形无交点或只有一个交点（切点），则此点在封闭图形外面；
;;;2，如果该直线与封闭图形有2个交点，且此点在这两个交点之间，则此点在封闭图形
;;;里面；在这两个交点之外，则此点在封闭图形外面；
;;;3，如果该直线与封闭图形有多个交点（不含切点），此点在这些交点之间时，此点
;;;任一侧的交点数为奇数则此点在封闭图形里面；此点任一侧的交点数为偶数则此点
;;;在封闭图形外面；此点不在这些交点之间时此点在封闭图形外面

动手写一个，效果好像还可以，如下
;;(MakeXray (setq p(getpoint)) '(0 1))
;;'(-1 0) 向左'(0 1)向上 '(1 0)向右 '(0 -1)向下
(defun MakeXray(p vector)
(entmakeX
(list
   '(0 . "RAY")
   '(100 . "AcDbEntity")
   '(100 . "AcDbRay")
   (cons 10 p)
   (cons 11 vector)
)
)
)

;;偶数判断
;;(IsEven 2)=>T
(defun IsEven (x)
(/= 1 (logand x 1))
)

;;向左产生一条射线ray
;; (setq ray (MakeXray p '(-1 0)))
(defun HH_PtInCurve (p curve ray / A B FLAG IN L PTS)
(setq Flag T)
(setq in nil)
(setq L '(((-1 0) (1 0)) ((0 1) (0 -1))))
;;射线移位
(entmod (append (entget ray) (list (cons 10 p))))
;;旋转射线
(while (and (setq a (car L)) Flag)
(setq L (cdr L))
(setq b (car a))
(setq a (cadr a))
(entmod (append (entget ray) (list (cons 11 b))))
(setq pts (HH:TwoEntsInters ray curve 0))
(cond ((not pts) (setq Flag nil))
((IsEven (length pts)) (setq Flag nil)) ;不严谨
(T
(entmod (append (entget ray) (list (cons 11 a))))
(setq pts (HH:TwoEntsInters ray curve 0))
(cond
   ((not pts) (setq Flag nil))
   ((IsEven (length pts)) (setq Flag nil)) ;不严谨
   (T (setq in T))
)
)
)
)
in
)

;;判断准则
;;1 如果所有端点首尾相连，则直接联接成多段线
;;2 如果只有一个端点是孤立的，则奇怪，可掉这条线
;;3 如果有两个端点孤立：是同一条线，奇怪，可去掉；如果是不同的线，可直接联接成多段线
;;4 如果大于两个端点孤立的，则相互延伸剪切，然后组成多段线。从一条线端点到另一条线最近的距离开始
;;0 [功能] 两对象交点
;;[功能] 两对象交点列表
;;acextendnone 0 不延伸
;;acextendthisentity 1 延伸基准对象
;;acextendotherentity 2
;;acextendboth 3
;;示例(HH:TwoEntsInters (car(entsel)) (car(entsel)) acextendboth)
(defun HH:TwoEntsInters (e1 e2 Flag / PTL PTS)
(if (equal 'ENAME (type e1))
(setq e1 (vlax-ename->vla-object e1))
)
(if (equal 'ENAME (type e2))
(setq e2 (vlax-ename->vla-object e2))
)
(setq pts (vlax-invoke e1 'Intersectwith e2 Flag))
(while pts
(setq ptl (cons (list (car pts) (cadr pts)) ptl))
(setq pts (cdddr pts))
)
ptl
)

;;;;;测试
(defun C:t1 (/ CURVE P RAY)
(setq ray (MakeXray '(0 0) '(-1 0)))
(setq curve (car (entsel "\n封闭曲线")))
(setq p (getpoint "\n点"))
(if (HH_PtInCurve p curve ray)
(alert "点在曲线内")
(alert "外")
)
(entdel ray)
(princ)
)

Andyhon 发表于 2024-3-29 16:36:31

(defun PtInPoly (/ clst apt delta ints oLine oPline pl pline someAngle)
(vl-load-com)
(cond
((setq pline (car (entsel "\nPolyline: ")))
;; NO error checking .. assume a lwpoly is selected!
(setq oPline (vlax-ename->vla-object pline)
      ;; pick point to investigate
      aPt    (getpoint "\nPick point: ")
      ;; initialize starting angle for "ray"
      someAngle 0.0
      ;; set delta angle for rotation of "ray"
      delta (/ (* 2 pi) 8)
)
(cond
   ;; start by making a "ray" shooting out from aPt
   ;; (should use vla-add but what the heck)
   ;; (should also use a real RAY and manipulate
   ;;unit vector .. but what the heck)
   ((entmake (list '(0 . "LINE") (cons 10 aPt)
                  (cons 11 (polar aPt 0.0 100.0))
            )
   )
   (setq oline (vlax-ename->vla-object (entlast)))
   (repeat 8
      (cond
         ;; get intersection points with pline and "ray"
         ((setq ints (vla-intersectwith oPline oLine acExtendNone))
         ;; should be using vlax-...-u-bounds and all that to check
         ;; safearray (but what the heck, this is quicker to write)
         (if (not (vl-catch-all-error-p (setq ints (vl-catch-all-apply
                                 'vlax-safearray->list
                                 (list (vlax-variant-value ints)))
                     )
                  )
            )
            ;; just put nil for uneven number of hits and T for even
            (setq clst (cons (not (zerop (rem (length ints) 2.0))) clst))
         )
         )
      )
      ;; pause to see the "ray" move around
      (while (not (grread nil 10)))
      ;; move endpoint of "ray"
      (vla-put-endpoint oLine (vlax-3D-point
         (polar aPt (setq someAngle (+ delta someAngle)) 100.0)
         )
      )
   )
   (vla-delete oLine)
   (vlax-release-object oLine)
   (vlax-release-object oPline)
   )
)
)
)
;; .. and a lazy decoding of result:
(cond ((not (member 'nil clst))(princ "Inside"))
   ((not (member 'T clst))(princ "Outside"))
   ((princ "Probably on an edge or vertex")))
(terpri)
clst
)

info from:
https://www.theswamp.org/index.php?topic=1890.0

自贡黄明儒 发表于 2024-3-28 10:38:58

4条ray,交点出现一奇一偶，或者一偶一奇，概率相当小了
(defun HH_PtInCurve (p curve ray / A B FLAG IN L PTS)
(setq Flag T)
(setq in nil)
(setq L '(((-1 0) (1 0)) ((0 1) (0 -1))))
;;射线移位
(entmod (append (entget ray) (list (cons 10 p))))
;;旋转射线
(while (and (setq a (car L)) Flag)
(setq L (cdr L))
(setq b (car a))
(setq a (cadr a))
(entmod (append (entget ray) (list (cons 11 b))))
(setq pts (HH:TwoEntsInters ray curve 0))
(cond ((not pts) (setq Flag nil))
   ((IsEven (length pts))
   (entmod (append (entget ray) (list (cons 11 a))))
   (setq pts (HH:TwoEntsInters ray curve 0))
   (cond
      ((not pts) (setq Flag nil))
      ((IsEven (length pts)) (setq Flag nil)) ;2次偶数，判断点在曲线外，这比较合理
      ;;一偶一奇，不好判断，让程序继续运行，从另外两个方向判断
      ;;如果还是出现一偶一奇，in仍为nil,表示点在封闭曲线外
   )
   )
   (T
   (entmod (append (entget ray) (list (cons 11 a))))
   (setq pts (HH:TwoEntsInters ray curve 0))
   (cond
      ((not pts) (setq Flag nil))
      ((IsEven (length pts)))
      ;;一奇一偶，不好判断，让程序继续运行，从另外两个方向判断
      ;;如果还是出现一奇一偶，in仍为nil,表示点在封闭曲线外
      (T (setq in T));至少2次奇数，判断点在封闭曲线内，这比较合理
   )
   )
)
)
in
)

自贡黄明儒 发表于 2024-3-29 11:37:40

dtucad 发表于 2024-3-28 23:22
黄总666 以前有个射线法好像不够精确

多旋转一下射线，应该更可靠。从我使用来看，旋转4次，就足够了。

天天问 发表于 2024-3-28 09:36:44

多谢大佬示范

loveu515 发表于 2024-3-28 11:23:35

感谢分享

Noangler 发表于 2024-3-28 15:10:33

谢谢分享，赞一个！

hubeiwdlue 发表于 2024-3-28 15:14:51

赞一个！！学习学习。

xiaolong1487 发表于 2024-3-28 20:54:25

谢谢分享，学习了

tigcat 发表于 2024-3-28 20:55:58

谢谢黄总分享代码,黄老的cad国产了?

dtucad 发表于 2024-3-28 23:22:16

本帖最后由 dtucad 于 2024-3-28 23:31 编辑

黄总666 以前有个射线法好像不够精确

页: [1] 2

明经CAD社区's Archiver

判断：一个点在封闭曲线内