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

狂刀

一个巧妙的方法求曲线内部任意一点
;|
问题: 已知一条闭合多义线（有可能是拟合过的，也可能包含有弧度），
如何求在其区域内的一点的坐标，即只要求出的点的坐标在其区域内即可了。
原帖: http://www.xdcad.net/forum/showt ... 1753206#post1753206
|;


核心程序没有贴完,仅提供思路和框架,有兴趣的可以填空.
以下()处为空缺的一行代码,仅仅一行!!!.
测试可以下载附件,测试命令分别为
    tt1 : 返回(曲线内任意一点 曲线外任意一点)
        tt2 : 测试点是否在曲线内.
        tt3 : 用tt2判断tt1返回的结果.

2. 
   
3. ;|by 狂刀 .2005.4.1
   
4. 参数: e = 曲线实体.
   
5.       pt = 指定一点.如返回点,在曲线内;返回nil,在曲线外.
   
6.            pt取nil值. 返回 (曲线内任意一点 曲线外任意一点) 供其他程序使用.
   
7. |;
   
8. (defun getinpt (e p / oce os pt pf an d p1 p2 ee end)
   
9.   (princ "\n 判断点pt是否在曲线内或pt=nil时求曲线内任一点.-----by 狂刀 .2005.4.1")
   
10.   (setq oce (getvar "cmdecho")
    
11.         os (getvar "osmode")
    
12.         pt (vlax-curve-getstartpoint e)
    
13.         pf ()
    
14.         an ()
    
15.         d  ()
    
16.         p1 (polar pt an 1e-3)
    
17.         p2 (polar pt (+ PI an) 1e-3)
    
18.         ee (entlast)       
    
19.   )
    
20.   (setvar "cmdecho" 0)
    
21.   (setvar "osmode" 0)
    
22.   ()
    
23.   (if p
    
24.     (if () (setq end nil)(setq end p))
    
25.     (if () (setq end (list p2 p1)) (setq end (list p1 p2)))
    
26.   )
    
27.   ()
    
28.   (setvar "cmdecho" oce)
    
29.   (setvar "osmode" os)
    
30.   end
    
31. )

<br /> ;|by 狂刀 .2005.4.1 <br /> 参数: e = 曲线实体.<br />       pt = 指定一点.如返回点,在曲线内;返回nil,在曲线外.<br />            pt取nil值. 返回 (曲线内任意一点 曲线外任意一点) 供其他程序使用.<br /> |;<br /> (defun getinpt (e p / oce os pt pf an d p1 p2 ee end)<br />   (princ "\n 判断点pt是否在曲线内或pt=nil时求曲线内任一点.-----by 狂刀 .2005.4.1")<br />   (setq oce (getvar "cmdecho")<br />         os (getvar "osmode")<br />         pt (vlax-curve-getstartpoint e)<br />         pf ()<br />         an ()<br />         d  ()<br />         p1 (polar pt an 1e-3)<br />         p2 (polar pt (+ PI an) 1e-3)<br />         ee (entlast)        <br />   )<br />   (setvar "cmdecho" 0)<br />   (setvar "osmode" 0)<br />   ()<br />   (if p<br />     (if () (setq end nil)(setq end p))<br />     (if () (setq end (list p2 p1)) (setq end (list p1 p2)))<br />   )<br />   ()<br />   (setvar "cmdecho" oce)<br />   (setvar "osmode" os)<br />   end<br /> )

2. 
   
3. ;;测试程序1: 返回(曲线内任意一点 曲线外任意一点)
   
4. ;;因两个点很近,看返回结果单位精度小于4时候显示是一样的,其实是不同的两个点.
   
5. (defun c:tt1 (/ e pf an p1 p2 ee d)
   
6.   (if (and (setq el (entsel "\n选闭合曲线:"))
   
7.            (setq e (car el))
   
8.       )
   
9.     (if        (not(vl-catch-all-error-p(vl-catch-all-apply 'vlax-curve-getstartpoint (list e))));;判断曲线.
   
10.       (print (getinpt e nil))
    
11.     )
    
12.   )
    
13.   (princ)
    
14. )
    
15. ;;测试程序2: 测试点是否在曲线内.
    
16. (defun c:tt2 (/ e p pf an p1 p2 ee d)
    
17.   (if (and (setq el (entsel "\n选闭合曲线:"))
    
18.            (setq e (car el))
    
19.            (setq p (getpoint "\n测试点:"))
    
20.       )
    
21.     (if        (not(vl-catch-all-error-p(vl-catch-all-apply 'vlax-curve-getstartpoint (list e))));;判断曲线.
    
22.       (if (getinpt e p)(princ "\n 点在曲线内")(princ "\n 点在曲线外"))
    
23.     )
    
24.   )
    
25.   (princ)
    
26. )
    
27. ;;测试程序3:用程序2判断程序1返回的结果. 如果返回"奇怪,难道错了?"那么说明我的程序有bug.
    
28. (defun c:tt3 (/ e pt pf an p1 p2 ee d)
    
29.   (if (and (setq el (entsel "\n选闭合曲线:"))
    
30.            (setq e (car el))
    
31.       )
    
32.     (if        (not(vl-catch-all-error-p(vl-catch-all-apply 'vlax-curve-getstartpoint (list e))));;判断曲线.
    
33.       (if (getinpt e (setq pt (car(getinpt e nil))))
    
34.         (mapcar 'princ (list "\n 点" pt "在曲线内"))
    
35.         (princ "\n奇怪,难道错了?")
    
36.       )
    
37.     )
    
38.   )
    
39.   (princ)
    
40. )
    
41.   

<br /> ;;测试程序1: 返回(曲线内任意一点 曲线外任意一点)<br /> ;;因两个点很近,看返回结果单位精度小于4时候显示是一样的,其实是不同的两个点. <br /> (defun c:tt1 (/ e pf an p1 p2 ee d)<br />   (if (and (setq el (entsel "\n选闭合曲线:"))<br />            (setq e (car el))<br />       )<br />     (if        (not(vl-catch-all-error-p(vl-catch-all-apply 'vlax-curve-getstartpoint (list e))));;判断曲线.<br />       (print (getinpt e nil))<br />     )<br />   )<br />   (princ)<br /> )<br /> ;;测试程序2: 测试点是否在曲线内.<br /> (defun c:tt2 (/ e p pf an p1 p2 ee d)<br />   (if (and (setq el (entsel "\n选闭合曲线:"))<br />            (setq e (car el))<br />            (setq p (getpoint "\n测试点:"))<br />       )<br />     (if        (not(vl-catch-all-error-p(vl-catch-all-apply 'vlax-curve-getstartpoint (list e))));;判断曲线.<br />       (if (getinpt e p)(princ "\n 点在曲线内")(princ "\n 点在曲线外"))<br />     )<br />   )<br />   (princ)<br /> )<br /> ;;测试程序3:用程序2判断程序1返回的结果. 如果返回"奇怪,难道错了?"那么说明我的程序有bug.<br /> (defun c:tt3 (/ e pt pf an p1 p2 ee d)<br />   (if (and (setq el (entsel "\n选闭合曲线:"))<br />            (setq e (car el))<br />       )<br />     (if        (not(vl-catch-all-error-p(vl-catch-all-apply 'vlax-curve-getstartpoint (list e))));;判断曲线.<br />       (if (getinpt e (setq pt (car(getinpt e nil))))<br />         (mapcar 'princ (list "\n 点" pt "在曲线内"))<br />         (princ "\n奇怪,难道错了?")<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />   

JOSDENNIS

你處理的曲線的條件是 卦閉的?    還是不封閉的????   我也是大掃了一眼, 還沒有測試. 先行問問.

狂刀

封闭不封闭都可以（如果曲线有内外的话）
但加一个封闭判断会更好。


顾者寥寥,周日删贴,要下的赶紧吧

kohi

题目叙述不太严密: 曲线是没有内外的(在曲线上或非) .
按照内容看应叙述为曲线围合或包容的区域内外?

狂刀

谢谢提出，来晓东论坛的朋友很多，国内外都有，朋友你现在是在国内还是国外？
哦，对不起，我说的不够严谨，国是没有内外的，按我的意思应该叙述为
朋友你现在是在中华人民共和国国家领土领海领空边界围合或包容的区域内或外？

LADESIGNER

pt本来是指定的一点，怎么又成了STARTPOINT了，笔误吧？

狂刀兄提示一下思路吧，确实很难哪。

aeo

"曲线上任意一点（比如：firstpoint），沿法线及法线+PI 取两点（距离可取很小）"

两点不可能一内一外的,比如一个很尖的角.

狂刀

说的对，所以后来改进了。取ｐａｒａｍ＝０．５的地方
对付一般的情况足够了，但是对有局部重合的还不完全适用
好老的帖子，我都忘了

dandee

请问此类判断有何实用意义？

tc405003

老大，可否把程序贴完啊，以飨我们这些忠实的支持都

zhaoyafei19

好程序
辅助作图的好帮手

tchen_sanmao

楼主 我等级不够啊 能不能把源程序直接全部贴上来  研究一下啊
谢谢!

swhlzl

楼主的程序测试程序，不错，提供了很好的思路

276448402

我一直在找一个点到曲线的垂距？
那位高手给个贴，感谢

taner

http://www.theswamp.org/index.php?topic=7514.0

俺也弄了一个，不过，过程搞得比较复杂！请大家测试下。

2. 
   
3.   [FONT=courier new]
   
4. (defun c:test1 (/ e)
   
5.   (if (setq e (car (entsel "\n请点取封闭曲线：")))
   
6.     (th-getpt-incurve-if e nil)
   
7.   )
   
8. )
   
9. (defun c:test2 (/ e mark pt)
   
10.   (if (and
    
11.         (setq e (car (entsel "\n请点取封闭曲线：")))
    
12.         (setq pt (getpoint "\n请选取点:"))
    
13.       )
    
14.     (progn
    
15.       (setq mark (th-getpt-incurve-if e pt))
    
16.       (if (= mark "in")
    
17.         (princ (strcat "\n点" (vl-princ-to-string pt) "在曲线内。"))
    
18.       )
    
19.       (if (= mark "on")
    
20.         (princ (strcat "\n点" (vl-princ-to-string pt) "在曲线上。"))
    
21.       )
    
22.       (if (= mark "out")
    
23.         (princ (strcat "\n点" (vl-princ-to-string pt) "在曲线外。"))
    
24.       )
    
25.     )
    
26.   )
    
27.   (princ)
    
28. )
    
29.   [/FONT]
    

<br />   [FONT=courier new]<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 />   [/FONT]<br />