[分享]：如何判断一个点是否在一个实体上？

lsjjm

如何判断一个点是否在一个实体上？
判断一个点是否在一条直线上论坛已有帖子阐述。也有关于圆和圆弧的简单实体。 对于复杂实体就爱能莫助了. 借助ActiveX中的intersectwith方法，下列ptatent程序可判断一点是否在任何实体上，包括椭圆，多义线和样条曲线。
考虑到大家使用的习惯，参数point是点表，ent为实体。欢迎试用。
(defun c:test ()
  (setq p (getpoint "\nPick a Point"))
  (setq ent (car (entsel "\nSelect First Object: ")))
  (ptatent p ent)
)
(defun ptatent (p ent)
  (vl-load-com)
  (vl-cmdf "_point" p)
  (setq obj1 (vlax-ename->vla-object (entlast)))
  (setq obj2 (vlax-ename->vla-object ent))
  (setq pts (vla-IntersectWith obj1 obj2 acExtendnone))
  (setq ins (not (minusp (vlax-safearray-get-u-bound
                           (vlax-variant-value pts) 1))))
   ins
);

LUCAS

2. 
   
3. ;;用点选对象判别是否在对象上
   
4. 
   
5. (defun TT (ENT PT / HOLDPICK FLAG SS)
   
6.   (setq HOLDPICK (getvar "PICKBOX"))
   
7.   (setvar "PICKBOX" 0)
   
8.   (if (and (setq SS (ssget PT))
   
9.            (equal (ssname SS 0) ENT)
   
10.       )
    
11.     (setq FLAG t)
    
12.   )
    
13.   (setvar "PICKBOX" HOLDPICK)
    
14.   FLAG
    
15. )
    
16. 
    
17. 
    
18. ;|
    
19. 指令: _line 指定第一点: 0,0
    
20. 
    
21. 指定下一点或 [复原(U)]: 100,0
    
22. 
    
23. 指定下一点或 [复原(U)]:
    
24. 
    
25. 指令: (SETQ WW (ENTLAST))
    
26. <像素名称: 40245868>
    
27. 
    
28. 指令: (TT WW '(50 0.1))
    
29. nil
    
30. 
    
31. 指令: (TT WW '(50 0.000001))
    
32. nil
    
33. 
    
34. 指令: (TT WW '(50 0.0000001))
    
35. T
    
36. 
    
37. |;
    

<br /> ;;用点选对象判别是否在对象上<br /> <br /> (defun TT (ENT PT / HOLDPICK FLAG SS)<br />   (setq HOLDPICK (getvar "PICKBOX"))<br />   (setvar "PICKBOX" 0)<br />   (if (and (setq SS (ssget PT))<br />            (equal (ssname SS 0) ENT)<br />       )<br />     (setq FLAG t)<br />   )<br />   (setvar "PICKBOX" HOLDPICK)<br />   FLAG<br /> )<br /> <br /> <br /> ;|<br /> 指令: _line 指定第一点: 0,0<br /> <br /> 指定下一点或 [复原(U)]: 100,0<br /> <br /> 指定下一点或 [复原(U)]:<br /> <br /> 指令: (SETQ WW (ENTLAST))<br /> <像素名称: 40245868><br /> <br /> 指令: (TT WW '(50 0.1))<br /> nil<br /> <br /> 指令: (TT WW '(50 0.000001))<br /> nil<br /> <br /> 指令: (TT WW '(50 0.0000001))<br /> T<br /> <br /> |;<br />

eachy

试试这个

2. 
   
3. (defun $ea_iscurve (objectname)
   
4.   (member objectname
   
5.           '("AcDbArc"               "AcDbPolyline"          "AcDbLine"
   
6.             "AcDbEllipse"      "AcDbSpline"          "AcDbCircle"
   
7.             "AcDb2dPolyline"
   
8.            )
   
9.   )
   
10. )
    
11. (defun ea:ison (e pt / obj ptmp)
    
12.   (setq obj (vlax-ename->vla-object e))
    
13.   (if ($ea_iscurve (vla-get-objectname obj))
    
14.     (progn
    
15.       (setq ptmp (vlax-curve-getClosestPointTo obj pt))
    
16.       (equal ptmp pt)
    
17.     )
    
18.   )
    
19. )

<br /> (defun $ea_iscurve (objectname)<br />   (member objectname<br />           '("AcDbArc"               "AcDbPolyline"          "AcDbLine"<br />             "AcDbEllipse"      "AcDbSpline"          "AcDbCircle"<br />             "AcDb2dPolyline"<br />            )<br />   )<br /> )<br /> (defun ea:ison (e pt / obj ptmp)<br />   (setq obj (vlax-ename->vla-object e))<br />   (if ($ea_iscurve (vla-get-objectname obj))<br />     (progn<br />       (setq ptmp (vlax-curve-getClosestPointTo obj pt))<br />       (equal ptmp pt)<br />     )<br />   )<br /> )

aeo

2. 
   
3. (defun pt-on-curve(pt e)
   
4. (if(vlax-curve-getParamAtPoint (vlax-ename->vla-object e) Pt)t nil)
   
5. )
   

<br /> (defun pt-on-curve(pt e)<br /> (if(vlax-curve-getParamAtPoint (vlax-ename->vla-object e) Pt)t nil)<br /> )<br />

t--在线上

eachy

最初由 aeo 发布
[B]

2. 
   
3. (defun pt-on-curve(pt e)
   
4. (if(vlax-curve-getParamAtPoint (vlax-ename->vla-object e) Pt)t nil)
   
5. )
   

<br /> (defun pt-on-curve(pt e)<br /> (if(vlax-curve-getParamAtPoint (vlax-ename->vla-object e) Pt)t nil)<br /> )<br />

t--在线上 [/B]

加个错误处理

2. 
   
3. (defun ea:ison (e pt / curve)
   
4.   (setq curve (vlax-ename->vla-object e))
   
5.   (if (vl-catch-all-error-p
   
6.         (vl-catch-all-apply
   
7.           'vlax-curve-getParamatpoint
   
8.           (list        curve
   
9.                 pt
   
10.           )
    
11.         )
    
12.       )
    
13.     nil
    
14.     t
    
15.   )
    
16. )

<br /> (defun ea:ison (e pt / curve)<br />   (setq curve (vlax-ename->vla-object e))<br />   (if (vl-catch-all-error-p<br />         (vl-catch-all-apply<br />           'vlax-curve-getParamatpoint<br />           (list        curve<br />                 pt<br />           )<br />         )<br />       )<br />     nil<br />     t<br />   )<br /> )

aeo

不在curve,vlax-curve-getParamatpoint就为nil,不会出错.

你写的是错的,你试试
道理也说不过去:不出错就在curve上?

eachy

最初由 aeo 发布
[B]不在curve,vlax-curve-getParamatpoint就为nil,不会出错.

你写的是错的,你试试
道理也说不过去:不出错就在curve上? [/B]

出错处理的是 e 实体，如果 e 是块实体（不是 Curve） ， vlax-curve-getParamatpoint 会出错。