[弹指神通]：(愚人节礼物)!!!一个巧妙的方法求曲线内部任意一点

Koyote

不错，程序很好

taner

源码

2. 
   
3.   [FONT=courier new]
   
4. (setq %24pai (* pi 0.5))
   
5. ;;; ==================================================================
   
6. ;;; 判断点在曲线内与否。在曲线内，返回＂in＂，在曲线上，返回＂on＂
   
7. ;;; 在曲线外，返回"out".若pt为nil，则返回曲线内一点
   
8. (defun th-getpt-incurve-if (ename pt)
   
9.   (if pt
   
10.     (th-if-pt-in-curve pt ename)
    
11.     (th-get-pt-in-curve ename)
    
12.   )
    
13. )
    
14. ;;; ==================================================================
    
15. ;;; 返回曲线内一点
    
16. (defun th-get-pt-in-curve (ename / ang len mark pt pt1 pt2 ptin)
    
17.   (setq len (t2-get-curve-length ename))
    
18.   (if (< len 100)
    
19.     (setq len 100)
    
20.     (setq len (fix len))
    
21.   )
    
22.   (setq mark t)
    
23.   (while mark
    
24.     (setq pt (th-m/n-pt-curve ename (txt-rnd-r 1 (1- len)) len))
    
25.     (setq ang (th-get-tangent@pt ename pt))
    
26.     (setq pt1 (polar pt (+ ang %24pai) 1e-3))
    
27.     (setq pt2 (polar pt (- ang %24pai) 1e-3))
    
28.     (if (= "in" (th-if-pt-in-curve pt1 ename))
    
29.       (setq ptin pt1
    
30.             mark nil
    
31.       )
    
32.     )
    
33.     (if (= "in" (th-if-pt-in-curve pt2 ename))
    
34.       (setq ptin pt2
    
35.             mark nil
    
36.       )
    
37.     )
    
38.   )
    
39.   ptin
    
40. )
    
41. ;;; ==================================================================
    
42. ;;; 返回曲线上的m／n等分点。如(th-m/n-pt-curve (car(entsel)) 80 100)
    
43. (defun th-m/n-pt-curve (ename m n / curlen pt)
    
44.   (setq curlen (t2-get-curve-length ename))
    
45.   (and
    
46.     (<= 0 m n)
    
47.     (setq pt (vlax-curve-getpointatdist ename (* m (/ curlen n) 1.0)))
    
48.   )
    
49.   pt
    
50. )
    
51. ;;; ==================================================================
    
52. ;;; 返回曲线长度
    
53. (defun t2-get-curve-length (e)
    
54.   (if (vlax-property-available-p (vlax-ename->vla-object e) "length")
    
55.     (vla-get-length (vlax-ename->vla-object e))
    
56.     0
    
57.   )
    
58. )
    
59. ;;; ==================================================================
    
60. ;;; 返回曲线上某点的切线角
    
61. (defun th-get-tangent@pt (obj pnt / curpar pntlst tmppnt)
    
62.   (setq pntlst (th-get-endpts obj)
    
63.         curpar (cond
    
64.                  ((equal pnt (car pntlst) 1e-5)
    
65.                    (vlax-curve-getstartparam obj)
    
66.                  )
    
67.                  ((equal pnt (cadr pntlst) 1e-5)
    
68.                    (vlax-curve-getendparam obj)
    
69.                  )
    
70.                  ((setq tmppnt (vlax-curve-getclosestpointto obj pnt))
    
71.                    (if (<= (distance tmppnt pnt) 1e-5)
    
72.                      (vlax-curve-getparamatpoint obj tmppnt)
    
73.                    )
    
74.                  )
    
75.                  (t
    
76.                    nil
    
77.                  )
    
78.                )
    
79.   )
    
80.   (if curpar
    
81.     (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv obj curpar))
    
82.   )
    
83. )
    
84. ;;; ==================================================================
    
85. ;;; 返回始终点列表
    
86. (defun th-get-endpts (obj)
    
87.   (list (vlax-curve-getstartpoint obj) (vlax-curve-getendpoint obj))
    
88. )
    
89. ;;; ==================================================================
    
90. ;;; 判断点在曲线内与否。在曲线内，返回＂in＂，在曲线上，返回＂on＂
    
91. ;;; 在曲线外，返回"out".
    
92. (defun th-if-pt-in-curve (pt ent / count mark tmpray)
    
93.   (if (equal pt (vlax-curve-getclosestpointto ent pt) 1e-6)
    
94.     (setq mark "on")
    
95.     (progn
    
96.       (setq ent (vlax-ename->vla-object ent)
    
97.             tmpray (vlax-ename->vla-object (entmakex (list '(0 . "RAY") '
    
98.                                                            (100 . "AcDbEntity")
    
99.                                                            '(100 . "AcDbRay")
    
100.                                                            (cons 10 pt)
     
101.                                                            (cons 11
     
102.                                                                  (polar pt
     
103.                                                                         (txt-rnd-r 0 pi)
     
104.                                                                         1
     
105.                                                                  )
     
106.                                                            )
     
107.                                                      )
     
108.                                            )
     
109.                    )
     
110.             pt (vlax-3d-point pt)
     
111.             count 0
     
112.       )
     
113.       (repeat 60
     
114.         (vla-rotate tmpray pt (/ pi 30))
     
115.         (if (zerop (rem (length (vlax-invoke ent 'intersectwith tmpray 0)) 6))
     
116.           (setq count (1- count))
     
117.           (setq count (1+ count))
     
118.         )
     
119.       )
     
120.       (vla-delete tmpray)
     
121.       (if (minusp count)
     
122.         (setq mark "out")
     
123.         (setq mark "in")
     
124.       )
     
125.     )
     
126.   )
     
127.   mark
     
128. )
     
129. ;;; ==================================================================
     
130. ;;; 求随机数(0~1)－－ｂｙ　狂刀
     
131. (defun txt-rnd ()                      ; 随机数种子
     
132.   (* (rem (getvar "cputicks") 1e3) 1e-3)
     
133. )
     
134. ;;; 求ｎ个ａ～ｂ随机数列表----ｂｙ　狂刀
     
135. (defun txt-rnd-rlst (a b n / c lst)    ; 随机数表
     
136.   (setq c (- b a))
     
137.   (repeat n
     
138.     (setq lst (cons (+ a (* (txt-rnd) c)) lst))
     
139.   )
     
140. )
     
141. (defun txt-rnd-r (a b)                 ; 单个随机数
     
142.   (car (txt-rnd-rlst a b 1))
     
143. )
     
144. ;;; ==================================================================
     
145. (defun c:test1 (/ e)
     
146.   (if (setq e (car (entsel "\n请点取封闭曲线：")))
     
147.     (th-getpt-incurve-if e nil)
     
148.   )
     
149. )
     
150. (defun c:test2 (/ e mark pt)
     
151.   (if (and
     
152.         (setq e (car (entsel "\n请点取封闭曲线：")))
     
153.         (setq pt (getpoint "\n请选取点:"))
     
154.       )
     
155.     (progn
     
156.       (setq mark (th-getpt-incurve-if e pt))
     
157.       (if (= mark "in")
     
158.         (princ (strcat "\n点" (vl-princ-to-string pt) "在曲线内。"))
     
159.       )
     
160.       (if (= mark "on")
     
161.         (princ (strcat "\n点" (vl-princ-to-string pt) "在曲线上。"))
     
162.       )
     
163.       (if (= mark "out")
     
164.         (princ (strcat "\n点" (vl-princ-to-string pt) "在曲线外。"))
     
165.       )
     
166.     )
     
167.   )
     
168.   (princ)
     
169. )
     
170. ;;; ==================================================================
     
171. 
     
172.   [/FONT]
     

<br />   [FONT=courier new]<br /> (setq %24pai (* pi 0.5))<br /> ;;; ==================================================================<br /> ;;; 判断点在曲线内与否。在曲线内，返回＂in＂，在曲线上，返回＂on＂<br /> ;;; 在曲线外，返回"out".若pt为nil，则返回曲线内一点<br /> (defun th-getpt-incurve-if (ename pt)<br />   (if pt<br />     (th-if-pt-in-curve pt ename)<br />     (th-get-pt-in-curve ename)<br />   )<br /> )<br /> ;;; ==================================================================<br /> ;;; 返回曲线内一点<br /> (defun th-get-pt-in-curve (ename / ang len mark pt pt1 pt2 ptin)<br />   (setq len (t2-get-curve-length ename))<br />   (if (< len 100)<br />     (setq len 100)<br />     (setq len (fix len))<br />   )<br />   (setq mark t)<br />   (while mark<br />     (setq pt (th-m/n-pt-curve ename (txt-rnd-r 1 (1- len)) len))<br />     (setq ang (th-get-tangent@pt ename pt))<br />     (setq pt1 (polar pt (+ ang %24pai) 1e-3))<br />     (setq pt2 (polar pt (- ang %24pai) 1e-3))<br />     (if (= "in" (th-if-pt-in-curve pt1 ename))<br />       (setq ptin pt1<br />             mark nil<br />       )<br />     )<br />     (if (= "in" (th-if-pt-in-curve pt2 ename))<br />       (setq ptin pt2<br />             mark nil<br />       )<br />     )<br />   )<br />   ptin<br /> )<br /> ;;; ==================================================================<br /> ;;; 返回曲线上的m／n等分点。如(th-m/n-pt-curve (car(entsel)) 80 100)<br /> (defun th-m/n-pt-curve (ename m n / curlen pt)<br />   (setq curlen (t2-get-curve-length ename))<br />   (and<br />     (<= 0 m n)<br />     (setq pt (vlax-curve-getpointatdist ename (* m (/ curlen n) 1.0)))<br />   )<br />   pt<br /> )<br /> ;;; ==================================================================<br /> ;;; 返回曲线长度<br /> (defun t2-get-curve-length (e)<br />   (if (vlax-property-available-p (vlax-ename->vla-object e) "length")<br />     (vla-get-length (vlax-ename->vla-object e))<br />     0<br />   )<br /> )<br /> ;;; ==================================================================<br /> ;;; 返回曲线上某点的切线角<br /> (defun th-get-tangent@pt (obj pnt / curpar pntlst tmppnt)<br />   (setq pntlst (th-get-endpts obj)<br />         curpar (cond<br />                  ((equal pnt (car pntlst) 1e-5)<br />                    (vlax-curve-getstartparam obj)<br />                  )<br />                  ((equal pnt (cadr pntlst) 1e-5)<br />                    (vlax-curve-getendparam obj)<br />                  )<br />                  ((setq tmppnt (vlax-curve-getclosestpointto obj pnt))<br />                    (if (<= (distance tmppnt pnt) 1e-5)<br />                      (vlax-curve-getparamatpoint obj tmppnt)<br />                    )<br />                  )<br />                  (t<br />                    nil<br />                  )<br />                )<br />   )<br />   (if curpar<br />     (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv obj curpar))<br />   )<br /> )<br /> ;;; ==================================================================<br /> ;;; 返回始终点列表<br /> (defun th-get-endpts (obj)<br />   (list (vlax-curve-getstartpoint obj) (vlax-curve-getendpoint obj))<br /> )<br /> ;;; ==================================================================<br /> ;;; 判断点在曲线内与否。在曲线内，返回＂in＂，在曲线上，返回＂on＂<br /> ;;; 在曲线外，返回"out".<br /> (defun th-if-pt-in-curve (pt ent / count mark tmpray)<br />   (if (equal pt (vlax-curve-getclosestpointto ent pt) 1e-6)<br />     (setq mark "on")<br />     (progn<br />       (setq ent (vlax-ename->vla-object ent)<br />             tmpray (vlax-ename->vla-object (entmakex (list '(0 . "RAY") '<br />                                                            (100 . "AcDbEntity")<br />                                                            '(100 . "AcDbRay")<br />                                                            (cons 10 pt)<br />                                                            (cons 11<br />                                                                  (polar pt<br />                                                                         (txt-rnd-r 0 pi)<br />                                                                         1<br />                                                                  )<br />                                                            )<br />                                                      )<br />                                            )<br />                    )<br />             pt (vlax-3d-point pt)<br />             count 0<br />       )<br />       (repeat 60<br />         (vla-rotate tmpray pt (/ pi 30))<br />         (if (zerop (rem (length (vlax-invoke ent 'intersectwith tmpray 0)) 6))<br />           (setq count (1- count))<br />           (setq count (1+ count))<br />         )<br />       )<br />       (vla-delete tmpray)<br />       (if (minusp count)<br />         (setq mark "out")<br />         (setq mark "in")<br />       )<br />     )<br />   )<br />   mark<br /> )<br /> ;;; ==================================================================<br /> ;;; 求随机数(0~1)－－ｂｙ　狂刀<br /> (defun txt-rnd ()                      ; 随机数种子<br />   (* (rem (getvar "cputicks") 1e3) 1e-3)<br /> )<br /> ;;; 求ｎ个ａ～ｂ随机数列表----ｂｙ　狂刀<br /> (defun txt-rnd-rlst (a b n / c lst)    ; 随机数表<br />   (setq c (- b a))<br />   (repeat n<br />     (setq lst (cons (+ a (* (txt-rnd) c)) lst))<br />   )<br /> )<br /> (defun txt-rnd-r (a b)                 ; 单个随机数<br />   (car (txt-rnd-rlst a b 1))<br /> )<br /> ;;; ==================================================================<br /> (defun c:test1 (/ e)<br />   (if (setq e (car (entsel "\n请点取封闭曲线：")))<br />     (th-getpt-incurve-if e nil)<br />   )<br /> )<br /> (defun c:test2 (/ e mark pt)<br />   (if (and<br />         (setq e (car (entsel "\n请点取封闭曲线：")))<br />         (setq pt (getpoint "\n请选取点:"))<br />       )<br />     (progn<br />       (setq mark (th-getpt-incurve-if e pt))<br />       (if (= mark "in")<br />         (princ (strcat "\n点" (vl-princ-to-string pt) "在曲线内。"))<br />       )<br />       (if (= mark "on")<br />         (princ (strcat "\n点" (vl-princ-to-string pt) "在曲线上。"))<br />       )<br />       (if (= mark "out")<br />         (princ (strcat "\n点" (vl-princ-to-string pt) "在曲线外。"))<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> ;;; ==================================================================<br /> <br />   [/FONT]<br />

zj-οО○oοО

楼主是采用偏移面积比较法写的
用这方法有种情况会不适合
当曲线有交叉情况时，
面积比较就会出问题的

zj-οО○oοО

我也做了个。大家可以测试

zj-οО○oοО

测试命令:TT

ljttjl

楼上能否说说您实现点在闭合曲线内的思路？感谢

monkey12

很感谢分享，学习过程中

ljttjl

我实现的思路是这样的：
将闭合曲线和要判断的点位，均辅助生成实体（点可画很小的圆，再生成实体），然后对两实体进行交集判断，当交集为真，则点在闭合曲线内，当交集为假则不在闭合曲线内。