VB编程,对话框使用acedGetXXX函数和ACAD交互

NetBee

VB编程,非模态窗口中，如何中断当前原有的GETXXX命令，并重新运行另一GETXXXX
如下图

使用了功能：

3. Private Sub Form_Load()
5. Dim obj_Acad As Object, obj_Doc As Object, obj_ModelSpace As Object, obj_Util As Object
6. Set obj_Acad = GetObject(, "AutoCAD.application")
7. If Err Then
8.    Err.Clear
9.    On Error Resume Next
10.    Set obj_Acad = CreateObject("autocad.application")
11.    If Err Then
12.       Err.Clear
13.       MsgBox "不能运行AutoCAD,请检查是否安装！", vbOKOnly, "警告！"
14.       Exit Function
15.       End If
16. End If
17. obj_Acad.Visible = True
18. Set obj_Doc = obj_Acad.ActiveDocument
19. Set obj_Util = obj_Doc.Utility
20. Set obj_ModelSpace = obj_Doc.ModelSpace
21. End Sub
22. '获取点按钮
23. Private Sub Getpoint_Click()
24.             Dim pt As Variant
25.             Do While CAD.Getpoint(pt, vbCrLf & "获取点<退出>:")
26.                If IsNull(pt) Then
27.                     'lop1 = False
28.                 Else
29.                     CAD.Addcircle pt, 100
30.                 End If
31.             Loop
32. End Sub
34. Public Function Getpoint(ByRef rePnt As Variant, ByRef inputString As String, Optional Msg As String, Optional pt As Variant) As Boolean
35. 'On Error Resume Next
36. ActiveDoc
37. rePnt = obj_Util.Getpoint(, Msg)
38. If Err Then
39.          If Err.Number = -2145320928 Then
40.              'Dim inputString As String
41.              Err.Clear
42.              inputString = ThisDrawing.Utility.GetInput
43.              'GetPoint = True
44.          Else
45.          Getpoint = False
46.              MsgBox "getpoint错误: " & Err.Description
47.              Err.Clear
48.          End If
49.     Else
50.         ' Display point coordinates
51.         'MsgBox "The WCS of the point is: " & reVal(0) & ", " & reVal(1) & ", " & reVal(2), , "GetInput Example"
52.         Getpoint = True
53.     End If
54. End Function
55. Public Function GetEntity0(ByRef Retobj As Variant, ByRef inputString As String, Optional Msg As String = "") As Boolean
56. On Error Resume Next
57. Dim Point As Variant
58. ActiveDoc
59. obj_Util.GetEntity Retobj, Point, Msg
60. If Err Then
61.          If Err.Number = -2145320928 Then
62.          ' One of the keywords was entered
63.              Err.Clear
64.              inputString = ThisDrawing.Utility.GetInput
65.          Else
66.              MsgBox "GetEntity0错误: " & Err.Description
67.              Err.Clear
68.              GetEntity0 = False
69.          End If
70.     Else
71.         GetEntity0 = True
72.     End If
73. End Function
74. Public Function Addcircle(ByRef Center As Variant, ByVal Radius As Double) As Object
75. Dim obj_circle As Object       '定义圆对象
76. Dim newstr As String
77. On Error Resume Next
78. If Not boo Then
79.   MsgBox "请先生成autocad程序对象", vbOKOnly, "autocad程序对象？"
80.   Exit Function
81.   End If
82. Set obj_circle = obj_ModelSpace.Addcircle(Center, Radius)
83. Set Addcircle = obj_circle
84. End Function

Private Sub Form_Load() Dim obj_Acad As Object, obj_Doc As Object, obj_ModelSpace As Object, obj_Util As Object Set obj_Acad = GetObject(, "<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>.application") If Err Then    Err.Clear    On Error Resume Next    Set obj_Acad = CreateObject("autocad.application")    If Err Then       Err.Clear       MsgBox "不能运行AutoCAD,请检查是否安装！", vbOKOnly, "警告！"       Exit Function       End If End If obj_Acad.Visible = True Set obj_Doc = obj_Acad.ActiveDocument Set obj_Util = obj_Doc.Utility Set obj_ModelSpace = obj_Doc.ModelSpace End Sub '获取点按钮 Private Sub Getpoint_Click()             Dim pt As Variant             Do While CAD.Getpoint(pt, vbCrLf & "获取点<退出>:")                If IsNull(pt) Then                     'lop1 = False                 Else                     CAD.Addcircle pt, 100                 End If             Loop End Sub Public Function Getpoint(ByRef rePnt As Variant, ByRef inputString As String, Optional Msg As String, Optional pt As Variant) As Boolean 'On Error Resume Next ActiveDoc rePnt = obj_Util.Getpoint(, Msg) If Err Then          If Err.Number = -2145320928 Then              'Dim inputString As String              Err.Clear              inputString = ThisDrawing.Utility.GetInput              'GetPoint = True          Else          Getpoint = False              MsgBox "getpoint错误: " & Err.Description              Err.Clear          End If     Else         ' Display point coordinates         'MsgBox "The WCS of the point is: " & reVal(0) & ", " & reVal(1) & ", " & reVal(2), , "GetInput Example"         Getpoint = True     End If End Function Public Function GetEntity0(ByRef Retobj As Variant, ByRef inputString As String, Optional Msg As String = "") As Boolean On Error Resume Next Dim Point As Variant ActiveDoc obj_Util.GetEntity Retobj, Point, Msg If Err Then          If Err.Number = -2145320928 Then          ' One of the keywords was entered              Err.Clear              inputString = ThisDrawing.Utility.GetInput          Else              MsgBox "GetEntity0错误: " & Err.Description              Err.Clear              GetEntity0 = False          End If     Else         GetEntity0 = True     End If End Function Public Function Addcircle(ByRef Center As Variant, ByVal Radius As Double) As Object Dim obj_circle As Object       '定义圆对象 Dim newstr As String On Error Resume Next If Not boo Then   MsgBox "请先生成autocad程序对象", vbOKOnly, "autocad程序对象？"   Exit Function   End If Set obj_circle = obj_ModelSpace.Addcircle(Center, Radius) Set Addcircle = obj_circle End Function

*.Utility.GetPoint(, "Enter a point: ")
*.Utility.GetDistance(, "Enter distance: ")

想达到效果：
1、在非模态状态下，本来是使用getpoint的，但还是getpoint的命令状态下，就按获取距离按钮，这时就取消原命令而运行GetDistance
或
2、在非模态状态下，本来是使用GetDistance的，但还是GetDistance的命令状态下，就按获取点按钮，这时就取消原命令而运行getpoint

本意是想取消原命令，但实际却变成嵌套了，即运行完GetDistance后，还会要求选取一个点。
如何取消当前的命令呢(getXXXXX)

xiaowen

多谢分享,学习过程中.