[函数] 判断点在封闭曲线内，跟随黄总的步伐
;测试
(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)
)
;第一种
;判断点是否在非自交多边形内，使用射线交叉法，从要测试的点向任意方向引一条射线，统计射线与多边形边界的交点数量。如果交点数目是奇数，则点位于多边形内部；如果是偶数，则点位于多边形外部。如果交点为多边形顶点可能无法正确判断，此时旋转射线重新判断。
;参数：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);奇数，在线内
)
)
)
)
页:
[1]