[求助]：如何用VBA获得相对一个测试点在实体的最近点？

EnjoyVba

用GETENTITY方法拾取一个实体，得到的实体名和点，但是这个点不一定是实体上的点，如何用VBA获得相对这个点在实体的最近点？

XDSoft

GETENTITY方法返回实体名和鼠标点，这个鼠标点是按照PICKBOX变量设置的，因此点有可能不在实体上，如果要获得实体上的点，用GETPOINT和OSNAP，看下下面的代码：

2. 
   
3. [FONT=courier new]
   
4. Sub test()
   
5. Dim obj As Object
   
6. Dim ss As AcadSelectionSet
   
7. Dim allSS As AcadSelectionSets
   
8. Dim pt As Variant
   
9. Dim Oldsnapmode As Variant
   
10. Dim strName As String
    
11. 
    
12. 
    
13. 'Store the current setting of Osnap.
    
14. Oldsnapmode = ThisDrawing.GetVariable("OSMODE")
    
15. 
    
16. 'Specify the Osnap you want. 512 = Nearest point.
    
17. ThisDrawing.SetVariable "OSMODE", 512
    
18. 
    
19. pt = ThisDrawing.Utility.GetPoint(, "Pick an entity: ")
    
20. 
    
21. Set allSS = ThisDrawing.SelectionSets
    
22. 'Check to see if "myset" exists, if so delete it
    
23. For Each ss In allSS
    
24.    strName = ss.Name
    
25.    If ss.Name = "myset" Then
    
26.         ss.Delete
    
27.         Exit For
    
28.    End If
    
29. Next
    
30. 
    
31. Set ss = ThisDrawing.SelectionSets.Add("myset")
    
32. ss.SelectAtPoint (pt)
    
33. Set obj = ss.Item(0)
    
34. ss.Delete
    
35. 
    
36. 'The type of entity selected.
    
37. MsgBox "Entity " & obj.EntityName & " was selected at X= " & pt(0) & " and Y= "
    
38. & pt(1)
    
39. 'Restore Osnap setting.
    
40. ThisDrawing.SetVariable "OSMODE", Oldsnapmode
    
41. End Sub[/FONT]

<br /> [FONT=courier new]<br /> Sub test()<br /> Dim obj As Object<br /> Dim ss As AcadSelectionSet<br /> Dim allSS As AcadSelectionSets<br /> Dim pt As Variant<br /> Dim Oldsnapmode As Variant<br /> Dim strName As String<br /> <br /> <br /> 'Store the current setting of Osnap.<br /> Oldsnapmode = ThisDrawing.GetVariable("OSMODE")<br /> <br /> 'Specify the Osnap you want. 512 = Nearest point.<br /> ThisDrawing.SetVariable "OSMODE", 512<br /> <br /> pt = ThisDrawing.Utility.GetPoint(, "Pick an entity: ")<br /> <br /> Set allSS = ThisDrawing.SelectionSets<br /> 'Check to see if "myset" exists, if so delete it<br /> For Each ss In allSS<br />    strName = ss.Name<br />    If ss.Name = "myset" Then<br />         ss.Delete<br />         Exit For<br />    End If<br /> Next<br /> <br /> Set ss = ThisDrawing.SelectionSets.Add("myset")<br /> ss.SelectAtPoint (pt)<br /> Set obj = ss.Item(0)<br /> ss.Delete<br /> <br /> 'The type of entity selected.<br /> MsgBox "Entity " & obj.EntityName & " was selected at X= " & pt(0) & " and Y= "<br /> & pt(1)<br /> 'Restore Osnap setting.<br /> ThisDrawing.SetVariable "OSMODE", Oldsnapmode<br /> End Sub[/FONT]

xdcad2019

学习了，谢谢！