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

自贡黄明儒

希望G版过来看，下面的程序改对了没有。
highflybir大师的程序太复杂了，不好使用http://bbs.mjtd.com/thread-111851-1-1.html。

2. ;;164.42 [功能] 判断点在封闭曲线内外，自交曲线不适用
   
3. ;;根据Gu_xl程序改编，希望适合UCS-----自贡黄明儒 2014.11.20
   
4. ;;返回: 点在封闭曲线上或曲线内，返回T，否则返回nil
   
5. ;;测试: (HH:PtInCurveP  (car(entsel "\n选择曲线:")) (getpoint))
   
6. (defun HH:PtInCurveP (POLY PT / CLOCKWISEP CP CURVELENGTH D1 D2 DEV DIST ENDPARAM ISUCS LST LW MAXP MINP PARAM X)
   
7.   (setq IsUCS (= (getvar "WORLDUCS") 0))
   
8.   (cond (IsUCS (setq pt (trans pt 1 0))))
   
9.   (setq cp (vlax-curve-getclosestpointto poly pt))
   
10.   (cond
    
11.     ((equal pt cp 1e-8) T) ;_ 点在曲线上 T
    
12.     ((progn
    
13.        (setq lw (vlax-ename->vla-object POLY))
    
14.        (vla-GetBoundingBox lw 'MinP 'MaxP)
    
15.        (setq MinP (vlax-safearray->list MinP))
    
16.        (setq MaxP (vlax-safearray->list MaxP))
    
17.        (not (ALG:InCorner-p pt MinP MaxP))
    
18.      )
    
19.      NIL ;_ 点在曲线最小包围盒外 nil
    
20.     )
    
21.     (t
    
22.      (setq lst (_pnts:box (list MinP MaxP)))        ;4角点
    
23.      (setq
    
24.        lst (mapcar
    
25.        '(lambda (x)
    
26.     (vlax-curve-getParamAtPoint
    
27.       lw
    
28.       (vlax-curve-getClosestPointTo lw x)
    
29.     )
    
30.         )
    
31.        lst
    
32.      )
    
33.      ) ;_ 最小包围盒点在曲线上的投影点的参数表
    
34.      (setq ClockwiseP
    
35.       (or
    
36.         (<= (car lst) (cadr lst) (caddr lst) (cadddr lst))
    
37.         (<= (cadr lst) (caddr lst) (cadddr lst) (car lst))
    
38.         (<= (caddr lst) (cadddr lst) (car lst) (cadr lst))
    
39.         (<= (cadddr lst) (car lst) (cadr lst) (caddr lst))
    
40.       )
    
41.      ) ;_ 判断曲线是否为顺时针，顺时针 = T
    
42.      (setq endparam (vlax-curve-getendparam poly))
    
43.      (setq curvelength (vlax-curve-getDistAtParam poly endparam)) ;_ 曲线长度
    
44.      (setq param (vlax-curve-getparamatpoint poly cp))
    
45.      (setq dist (vlax-curve-getDistAtParam poly param))
    
46.      (if (equal param (fix param) 1e-8)
    
47.        (progn
    
48.    (cond ((minusp (setq d1 (- dist 1e-8))) (setq d1 (+ curvelength d1))))
    
49.    (cond ((> (setq d2 (+ dist 1e-8)) curvelength) (setq d2 (- d2 curvelength))))
    
50.    (setq d1 (vlax-curve-getpointatdist poly d1))
    
51.    (setq d2 (vlax-curve-getpointatdist poly d2))
    
52.    (if (<  (distance pt d1)
    
53.     (distance pt d2)
    
54.        )
    
55.      (setq param d1)
    
56.      (setq param d2)
    
57.    )
    
58.        )
    
59.      )
    
60.      (setq dev (vlax-curve-getFirstDeriv poly param)
    
61.      cp  (vlax-curve-getpointatparam poly param)
    
62.      )     
    
63.      (= ClockwiseP (minusp (det pt cp (mapcar '+ cp dev))))
    
64.     )
    
65.   )
    
66. )
    
67. 
    
68. 
    
69. ;; 判断点是否在窗口内  by highflybir
    
70. (defun ALG:InCorner-p (pt pMin pMax)
    
71.   (and
    
72.     (<= (car pMin) (car pt) (car pMax))
    
73.     (<= (cadr pMin) (cadr pt) (cadr pMax))
    
74.   )
    
75. )
    
76. ;;[功能] 两角点变四点(左下 右下 右上 左上)
    
77. (defun _pnts:box (box)
    
78.   (list  (car box)
    
79.   (list (caar box) (cadadr box) (last (car box)))
    
80.   (cadr box)
    
81.   (list (caadr box) (cadar box) (last (car box)))
    
82.   )
    
83. )
    
84. ;;174.2 [功能] 叉积(外积) By Highflybird
    
85. ;;1 三角形之倍面积
    
86. ;;2 p1 p2 p3 逆时针为正。
    
87. ;;3 三点共线为0
    
88. (defun det (p1 p2 p3 / x2 y2)
    
89.   (setq  x2 (car p2)
    
90.   y2 (cadr p2)
    
91.   )
    
92.   (- (* (- x2 (car p3)) (- y2 (cadr p1))) (* (- x2 (car p1)) (- y2 (cadr p3))))
    
93. )

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

flowerson

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