判断点在封闭曲线内外，自交曲线不适用-----希望适合UCS

/db_自贡黄明儒_ · 发表于 2014-11-20 16:54:17

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本人改编G版的程序，希望适合ucs,也不知改对没有，大家帮看看。
highflybir大师的那个程序大复杂，使用不便

;;164.42 [功能] 判断点在封闭曲线内外，自交曲线不适用-----希望适合UCS
;;根据Gu_xl程序改编，希望适合UCS-----自贡黄明儒 2014.11.20
;;返回: 点在封闭曲线上或曲线内，返回T，否则返回nil
;;测试: (HH:PtInCurveP (car(entsel "\n选择曲线:")) (getpoint))
(defun HH:PtInCurveP (POLY PT / CLOCKWISEP CP CURVELENGTH D1 D2 DEV DIST ENDPARAM ISUCS LST LW MAXP MINP PARAM X)
(setq IsUCS (= (getvar "WORLDUCS") 0))
(cond (IsUCS (setq pt (trans pt 1 0))))
(setq cp (vlax-curve-getclosestpointto poly pt))
(cond
((equal pt cp 1e-8) T) ;_ 点在曲线上 T
((progn
(setq lw (vlax-ename->vla-object POLY))
(vla-GetBoundingBox lw 'MinP 'MaxP)
(setq MinP (vlax-safearray->list MinP))
(setq MaxP (vlax-safearray->list MaxP))
(not (ALG:InCorner-p pt MinP MaxP))
)
NIL ;_ 点在曲线最小包围盒外 nil
)
(t
(setq lst (_pnts:box (list MinP MaxP))) ;4角点
(setq
lst (mapcar
'(lambda (x)
(vlax-curve-getParamAtPoint
lw
(vlax-curve-getClosestPointTo lw x)
)
)
lst
)
) ;_ 最小包围盒点在曲线上的投影点的参数表
(setq ClockwiseP
(or
(<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
(<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
(<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
(<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
)
) ;_ 判断曲线是否为顺时针，顺时针 = T
(setq endparam (vlax-curve-getendparam poly))
(setq curvelength (vlax-curve-getDistAtParam poly endparam)) ;_ 曲线长度
(setq param (vlax-curve-getparamatpoint poly cp))
(setq dist (vlax-curve-getDistAtParam poly param))
(if (equal param (fix param) 1e-8)
(progn
(cond ((minusp (setq d1 (- dist 1e-8))) (setq d1 (+ curvelength d1))))
(cond ((> (setq d2 (+ dist 1e-8)) curvelength) (setq d2 (- d2 curvelength))))
(setq d1 (vlax-curve-getpointatdist poly d1))
(setq d2 (vlax-curve-getpointatdist poly d2))
(if (< (distance pt d1)
(distance pt d2)
)
(setq param d1)
(setq param d2)
)
)
)
(setq dev (vlax-curve-getFirstDeriv poly param)
cp (vlax-curve-getpointatparam poly param)
)
(= ClockwiseP (minusp (det pt cp (mapcar '+ cp dev))))
)
)
)
;; 判断点是否在窗口内 by highflybir
(defun ALG:InCorner-p (pt pMin pMax)
(and
(<= (car pMin) (car pt) (car pMax))
(<= (cadr pMin) (cadr pt) (cadr pMax))
)
)
;;[功能] 两角点变四点(左下右下右上左上)
(defun _pnts:box (box)
(list (car box)
(list (caar box) (cadadr box) (last (car box)))
(cadr box)
(list (caadr box) (cadar box) (last (car box)))
)
)
;;174.2 [功能] 叉积(外积) By Highflybird
;;1 三角形之倍面积
;;2 p1 p2 p3 逆时针为正。
;;3 三点共线为0
(defun det (p1 p2 p3 / x2 y2)
(setq x2 (car p2)
y2 (cadr p2)
)
(- (* (- x2 (car p3)) (- y2 (cadr p1))) (* (- x2 (car p1)) (- y2 (cadr p3))))
)

;;164.42 [功能] 判断点在封闭曲线内外，自交曲线不适用-----希望适合UCS 
;;根据Gu_xl程序改编，希望适合UCS-----自贡黄明儒 2014.11.20 
;;返回: 点在封闭曲线上或曲线内，返回T，否则返回nil 
;;测试: (HH:PtInCurveP  (car(entsel "\n选择曲线:")) (getpoint)) 
(defun HH:PtInCurveP (POLY PT / CLOCKWISEP CP CURVELENGTH D1 D2 DEV DIST ENDPARAM ISUCS LST LW MAXP MINP PARAM X) 
  (setq IsUCS (= (getvar "WORLDUCS") 0)) 
  (cond (IsUCS (setq pt (trans pt 1 0)))) 
  (setq cp (vlax-curve-getclosestpointto poly pt)) 
  (cond 
    ((equal pt cp 1e-8) T) ;_ 点在曲线上 T 
    ((progn 
       (setq lw (vlax-ename->vla-object POLY)) 
       (vla-GetBoundingBox lw 'MinP 'MaxP) 
       (setq MinP (vlax-safearray->list MinP)) 
       (setq MaxP (vlax-safearray->list MaxP)) 
       (not (ALG:InCorner-p pt MinP MaxP)) 
     ) 
     NIL ;_ 点在曲线最小包围盒外 nil 
    ) 
    (t 
     (setq lst (_pnts:box (list MinP MaxP)))                    ;4角点 
     (setq 
       lst (mapcar 
             '(lambda (x) 
                (vlax-curve-getParamAtPoint 
                  lw 
                  (vlax-curve-getClosestPointTo lw x) 
                ) 
              ) 
             lst 
           ) 
     ) ;_ 最小包围盒点在曲线上的投影点的参数表 
     (setq ClockwiseP 
            (or 
              (<= (car lst) (cadr lst) (caddr lst) (cadddr lst)) 
              (<= (cadr lst) (caddr lst) (cadddr lst) (car lst)) 
              (<= (caddr lst) (cadddr lst) (car lst) (cadr lst)) 
              (<= (cadddr lst) (car lst) (cadr lst) (caddr lst)) 
            ) 
     ) ;_ 判断曲线是否为顺时针，顺时针 = T 
     (setq endparam (vlax-curve-getendparam poly)) 
     (setq curvelength (vlax-curve-getDistAtParam poly endparam)) ;_ 曲线长度 
     (setq param (vlax-curve-getparamatpoint poly cp)) 
     (setq dist (vlax-curve-getDistAtParam poly param)) 
     (if (equal param (fix param) 1e-8) 
       (progn 
         (cond ((minusp (setq d1 (- dist 1e-8))) (setq d1 (+ curvelength d1)))) 
         (cond ((> (setq d2 (+ dist 1e-8)) curvelength) (setq d2 (- d2 curvelength)))) 
         (setq d1 (vlax-curve-getpointatdist poly d1)) 
         (setq d2 (vlax-curve-getpointatdist poly d2)) 
         (if (<        (distance pt d1) 
                (distance pt d2) 
             ) 
           (setq param d1) 
           (setq param d2) 
         ) 
       ) 
     ) 
     (setq dev (vlax-curve-getFirstDeriv poly param) 
           cp  (vlax-curve-getpointatparam poly param) 
     )      
     (= ClockwiseP (minusp (det pt cp (mapcar '+ cp dev)))) 
    ) 
  ) 
) 
 
 
;; 判断点是否在窗口内  by highflybir 
(defun ALG:InCorner-p (pt pMin pMax) 
  (and 
    (<= (car pMin) (car pt) (car pMax)) 
    (<= (cadr pMin) (cadr pt) (cadr pMax)) 
  ) 
) 
;;[功能] 两角点变四点(左下 右下 右上 左上) 
(defun _pnts:box (box) 
  (list        (car box) 
        (list (caar box) (cadadr box) (last (car box))) 
        (cadr box) 
        (list (caadr box) (cadar box) (last (car box))) 
  ) 
) 
;;174.2 [功能] 叉积(外积) By Highflybird 
;;1 三角形之倍面积 
;;2 p1 p2 p3 逆时针为正。 
;;3 三点共线为0 
(defun det (p1 p2 p3 / x2 y2) 
  (setq        x2 (car p2) 
        y2 (cadr p2) 
  ) 
  (- (* (- x2 (car p3)) (- y2 (cadr p1))) (* (- x2 (car p1)) (- y2 (cadr p3)))) 
)

st788796 · 发表于 2014-11-21 07:58:01

本帖最后由 st788796 于 2014-11-21 08:06 编辑

黄老这个算法很巧妙，避免了以前的抽样点方法可能出现的误差，肯定花了不少功夫，给大家讲讲具体算法吧

不过首先要判断是否封闭，开放曲线就没有内外了

在 Arx 的 Brep 类中，将曲线构造一个 Brep （Region）就可以使用 getPointRelationToBrep 函数，返回 kInside、kOutside、kCoincident 等，也就是 xdrx_point_getRelationAtClosedCurve 方法，在ARX中构造 Brep 不需要实体添加到数据库的

/db_自贡黄明儒_ · 发表于 2014-11-21 08:02:35

st788796 发表于 2014-11-21 07:58
黄老这个算法很巧妙，避免了以前的抽样点方法可能出现的误差，肯定花了不少功夫，给大家讲讲具体算法吧

这个G版的呀，我只是希望用于UCS，其实只改了一句。(cond ((= (getvar "WORLDUCS") 0) (setq pt (trans pt 1 0))))

st788796 · 发表于 2014-11-21 08:08:59

本帖最后由 st788796 于 2014-11-22 08:59 编辑

/db_自贡黄明儒_ 发表于 2014-11-21 08:02
这个G版的呀，我只是希望用于UCS，其实只改了一句。(cond ((= (getvar "WORLDUCS") 0) (setq pt (trans p ...

vlax-curve 求出的都是 wcs , 对测试点直接 (trans pt 1 0) 不用判断
整理出几个基本函数

(defun _pnts:box (box)
(list (car box)
(list (caar box) (cadadr box) (last (car box)))
(cadr box)
(list (caadr box) (cadar box) (last (car box)))
)
)
(defun Curve:IsClosed (curve /)
(or (vlax-curve-isclosed curve)
(equal (vlax-curve-getstartpoint curve)
(vlax-curve-getendpoint curve)
1e-8
)
)
)
(defun Obj:Corner (ent / bp up)
(vla-getboundingbox ent 'bp 'up)
(list (safearray-value bp) (safearray-value up))
)
(defun Curve:Direction (curve / box params)
(setq box (_pnts:box (Obj:Corner curve))
params (mapcar
'(lambda (x)
(vlax-curve-getParamAtPoint
curve
(vlax-curve-getClosestPointTo curve x)
)
)
box
)
)
(or
(apply '<= params)
(<= (cadr lst) (caddr params) (cadddr params) (car params))
(<= (caddr params)
(cadddr params)
(car params)
(cadr params)
)
(<= (cadddr params)
(car params)
(cadr params)
(caddr params)
)
)
)

(defun _pnts:box (box) 
  (list        (car box) 
        (list (caar box) (cadadr box) (last (car box))) 
        (cadr box) 
        (list (caadr box) (cadar box) (last (car box))) 
  ) 
) 
(defun Curve:IsClosed (curve /) 
  (or (vlax-curve-isclosed curve) 
      (equal (vlax-curve-getstartpoint curve) 
             (vlax-curve-getendpoint curve) 
             1e-8 
      ) 
  ) 
) 
(defun Obj:Corner (ent / bp up) 
  (vla-getboundingbox ent 'bp 'up) 
  (list (safearray-value bp) (safearray-value up)) 
) 
(defun Curve:Direction (curve / box params) 
  (setq        box    (_pnts:box (Obj:Corner curve)) 
        params (mapcar 
                 '(lambda (x) 
                    (vlax-curve-getParamAtPoint 
                      curve 
                      (vlax-curve-getClosestPointTo curve x) 
                    ) 
                  ) 
                 box 
               ) 
  ) 
  (or 
    (apply '<= params) 
    (<= (cadr lst) (caddr params) (cadddr params) (car params)) 
    (<=        (caddr params) 
        (cadddr params) 
        (car params) 
        (cadr params) 
    ) 
    (<=        (cadddr params) 
        (car params) 
        (cadr params) 
        (caddr params) 
    ) 
  ) 
)

zhxatsx · 发表于 2014-11-21 10:09:07

本帖最后由 zhxatsx 于 2014-11-21 10:19 编辑

;;试试这个，只适用ucs，需要其他条件可变改
;;判断点是否在封闭曲线内部
(defun iop (/ e1 e2 p rp pint pn)
  (setq e1 (vlax-ename->vla-object (car (entsel "请选择封闭曲线："))))
  (setq p (getpoint "P: "))
  (setq       rp (entmakex (list '(0 . "ray")
                        '(100 . "AcDbEntity")
                        '(100 . "AcDbRay")
                        (cons 10 p)
                        '(11 1 0)
                  )
         )
  )
  (setq e2 (vlax-ename->vla-object rp))
  (setq pint (vlax-invoke e1 'intersectwith e2 0))
  (vlax-invoke-method e2 'delete)
  (setq pint (pm-ps pint))
  (cond
((member p pint) (prompt "\n此点在封闭曲线上"))
((and (setq pn (length pint)) (zerop (rem pn 2)))
   (prompt "\n此点在封闭曲线外部")
)
(t (prompt "\n此点在封闭曲线内部"))
  )
  (princ)
)

(defun Pm-Ps (pm / i)
  (setq       i  0
      ps '()
  )
  (repeat (/ (length pm) 3)
(setq ps (cons (list (nth i pm) (nth (1+ i) pm) (nth (+ i 2) pm)) ps)
      i  (+ i 3)
)
  )
  (setq ps (reverse ps))
)

/db_自贡黄明儒_ · 发表于 2014-11-21 10:18:47

本帖最后由 /db_自贡黄明儒_ 于 2014-11-21 10:21 编辑

zhxatsx 发表于 2014-11-21 10:09
;;试试这个
;;判断点是否在封闭曲线内部
(defun iop (/ e1 e2 p rp pint pn)

rp应该是e2,很早以前，就用射线法了。同样是适用于非自交多边形吧。但是如果有凹弧，也可能是3个交点的。

牢固 · 发表于 2014-11-21 18:34:17

/db_自贡黄明儒_ 发表于 2014-11-21 08:02
这个G版的呀，我只是希望用于UCS，其实只改了一句。(cond ((= (getvar "WORLDUCS") 0) (setq pt (trans p ...

增加此判断完全是画蛇添足，因为使用者调用此函数时明确知道pt是wcs还是ucs,你增加此判断判断出当前坐标系是ucs,也不能代表pt 坐标一定是ucs坐标！

/db_自贡黄明儒_ · 发表于 2014-11-22 12:54:24

st788796 发表于 2014-11-21 08:08
vlax-curve 求出的都是 wcs , 对测试点直接 (trans pt 1 0) 不用判断
整理出几个基本函数

你这么一搞，G版的东西看起来就短了，现代的人都喜欢长的，有故事为证，要不要我讲给你听{:soso_e112:}?

iLisp · 发表于 2014-11-22 13:00:18

/db_自贡黄明儒_ 发表于 2014-11-22 12:54
你这么一搞，G版的东西看起来就短了，现代的人都喜欢长的，有故事为证，要不要我讲给你听?
...

有故事就讲讲吗，洗耳恭听

newer · 发表于 2014-11-22 13:04:03

/db_自贡黄明儒_ 发表于 2014-11-22 12:54
你这么一搞，G版的东西看起来就短了，现代的人都喜欢长的，有故事为证，要不要我讲给你听?
...

难道古代人喜欢短的？{:soso_e120:}

/db_自贡黄明儒_ · 发表于 2014-11-22 13:24:50

本帖最后由 /db_自贡黄明儒_ 于 2014-11-22 13:29 编辑

iLisp喜欢听，我就讲讲，如果被版主封贴了，你要负责任{:soso_e112:}
据说男厕所卫生老是搞不好，在上面贴上“前近一小步，文明一大步”，英文大致意思是要小心瞄准，之类的标语，也不管用。后来把标语改了，一下卫生就搞好了。标语是这样的：如果尿不进尿槽，说明你的东西太短了。

iLisp · 发表于 2014-11-22 13:46:03

/db_自贡黄明儒_ 发表于 2014-11-22 13:24
iLisp喜欢听，我就讲讲，如果被版主封贴了，你要负责任
据说男厕所卫生老是搞不好，在上面贴 ...

哈哈，黄老师不愧是黄老师啊！

无痕 · 发表于 2014-11-25 03:13:28

射线法改进一下，射线给一个非整数角度，只要判断点不在曲线上，出现凹弧3点共线的几率是微乎其微的（可以忽略）

flowerson · 发表于 2019-7-30 15:35:20

本帖最后由 flowerson 于 2019-7-30 15:38 编辑

楼主，发现了错误。点取云线附近会出错。类似下面的提示：“选择曲线:; 错误: 参数类型错误: numberp: (-264910.0 105537.0 0.0)”附件为dwq图纸。请楼主帮检测是什么原因？云线以外程序是正常的。

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

[研讨] 判断点在封闭曲线内外，自交曲线不适用-----希望适合UCS

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

点评

点评

点评

评分

点评

点评

点评