[分享]：VBA get族交互选择技巧！

fjw_ok

Sub Example_GetPoint()
    ' This example returns a point entered by the user.
   
    Dim returnPnt As Variant
123:  On Error Resume Next

  
    returnPnt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
    If Err Then GoTo 123:
  
    MsgBox "The WCS of the point is: " & returnPnt(0) & ", " & returnPnt(1) & ", " & returnPnt(2) & vbCrLf

   
End Sub


'Utility的GET族函数在与屏幕交互输入时
'无法操作别的任何命令，实际上在运用中
'经常要移动屏幕，上面这个例子就是一个简单运用
'注意 123:的位置！

god

好，我又学到了一招。谢谢
还有什么高招请继续

还有个问题，请问哪有acad2002的VBA开发指南之类的电子书下载？

efan2000

可以根据返回的错误号来判断，并进行相应的处理，如下：

2. 
   
3.   [FONT=courier new]
   
4. Sub Example_GetPoint()
   
5. ' This example returns a point entered by the user.
   
6. 
   
7.     Dim returnPnt As Variant
   
8.     On Error GoTo ErrTrap
   
9.     returnPnt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
   
10.     MsgBox "The WCS of the point is: " & returnPnt(0) & ", " & returnPnt(1) & ", " & returnPnt(2) & vbCrLf
    
11.     Exit Sub
    
12. 
    
13. ErrTrap:
    
14.     If Err.Number = -2147352567 Then '运行其它的命令，如透明命令等
    
15.         Err.Clear
    
16.         Resume
    
17.     ElseIf Err.Number = -2147467259 Then '右键单击，这时ESC键无效，只能按右键退出，
    
18.     End If
    
19. On Error GoTo 0
    
20. End Sub
    
21. 
    
22.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub Example_GetPoint()<br /> ' This example returns a point entered by the user.<br /> <br />     Dim returnPnt As Variant<br />     On Error GoTo ErrTrap<br />     returnPnt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")<br />     MsgBox "The WCS of the point is: " & returnPnt(0) & ", " & returnPnt(1) & ", " & returnPnt(2) & vbCrLf<br />     Exit Sub<br /> <br /> ErrTrap:<br />     If Err.Number = -2147352567 Then '运行其它的命令，如透明命令等<br />         Err.Clear<br />         Resume<br />     ElseIf Err.Number = -2147467259 Then '右键单击，这时ESC键无效，只能按右键退出，<br />     End If<br /> On Error GoTo 0<br /> End Sub<br /> <br />   [/FONT]<br />

efan2000

上述方法，当发生错误而中断时，采用的是屏蔽错误的做法，那么如果这时用户想按ESC键来退出怎么办？ESC键在CAD中普遍用来中断命令，如何才能实现这种功能呢？这时可借助于API函数。
GetAsyncKeyState函数用来检测某一个键值的变更状态，如在键盘上按了某一个键。
下面的例子是用来在获取点时，检测是否按了ESC键。

2. 
   
3.   [FONT=courier new]
   
4. Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
   
5. 
   
6. Sub Example_GetPoint()
   
7.     Dim returnPnt As Variant
   
8. 
   
9.     On Error GoTo ErrTrap
   
10.     returnPnt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")
    
11.     Exit Sub
    
12. 
    
13. ErrTrap:
    
14.     If GetAsyncKeyState(&H1B) Then Exit Sub 'ESC键值为27，换算成十六进制为1B。
    
15.     If Err.Number = -2147352567 Then '运行其它的命令，如透明命令等
    
16.         Err.Clear
    
17.         Resume
    
18.     ElseIf Err.Number = -2147467259 Then '右键单击，这时ESC键无效，只能按右键退出，
    
19.     End If
    
20. On Error GoTo 0
    
21. End Sub
    
22. 
    
23.   [/FONT]
    

<br />   [FONT=courier new]<br /> Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer<br /> <br /> Sub Example_GetPoint()<br />     Dim returnPnt As Variant<br /> <br />     On Error GoTo ErrTrap<br />     returnPnt = ThisDrawing.Utility.GetPoint(, "Enter a point: ")<br />     Exit Sub<br /> <br /> ErrTrap:<br />     If GetAsyncKeyState(&H1B) Then Exit Sub 'ESC键值为27，换算成十六进制为1B。<br />     If Err.Number = -2147352567 Then '运行其它的命令，如透明命令等<br />         Err.Clear<br />         Resume<br />     ElseIf Err.Number = -2147467259 Then '右键单击，这时ESC键无效，只能按右键退出，<br />     End If<br /> On Error GoTo 0<br /> End Sub<br /> <br />   [/FONT]<br />