[VBA函数]：获取用户输入的问题？

macula55

怎样实现如下功能：
   
    提示用户：“选择对象或[设置(S)]：”后，
    用户在屏幕上选择对象，或者输入“S”进入设置窗口

我使用 GetEntity方法好像实现不了，
       GetEntity方法选择对象时如果输入字符则提示错误并让继续选择！
       而InitializeUserInput方法好像不支持GetEntity

whz919

好，支持

macula55

Sub Mccad_InitializeUserInput()
    ' 该示例提示用户选择对象，并通过
    ' InitializeUserInput 方法定义关键字列表，
    ' 用户要以用它来输入关键字。
   
    On Error Resume Next
   
    ' 定义有效的关键字
    Dim keywordList As String
    keywordList = "S E"
   
    ' 调用 InitializeUserInput 初始化关键字
    ThisDrawing.Utility.InitializeUserInput 0, keywordList
   
    ' 获得用户输入
    Dim Pnt As Variant
    Dim ent As AcadEntity
     ThisDrawing.Utility.GetEntity ent, Pnt, "选择对象[设置(S)/删除(E)]： "
    If Err Then
         If StrComp(Err.Number, -2145320928, 1) = 0 Then
         ' 当输入关键字时
             Dim inputString As String
             Err.Clear
             inputString = ThisDrawing.Utility.GetInput
             MsgBox "输入的关键字是: " & inputString
         Else
             MsgBox "选择对象出错: " & Err.Description
             Err.Clear
         End If
    Else
        ' 显示用户选定的对象类型
        MsgBox "你选定的对象类型为: " & ent.ObjectName, , "明经VBA示例：GetEntity及InitializeUserInput方法"
    End If
End Sub

gogogo168

如果我想单击右键能够退出怎么办？？？？单击右键的错误代码也是-2145320928，，怎么办？？？急判知道

雪山飞狐(lzh)

[php]
On Error Resume Next

' 定义有效的关键字
Dim keywordList As String
keywordList = "S E"

' 调用 InitializeUserInput 初始化关键字
ThisDrawing.Utility.InitializeUserInput 0, keywordList

' 获得用户输入
Dim Pnt As Variant
Dim ent As AcadEntity
ThisDrawing.Utility.GetEntity ent, Pnt, "选择对象[设置(S)/删除(E)]： "
If Err Then
    If Err.Number = -2147467259 Then
        ' 当输入关键字时
        Dim inputString As String
        Err.Clear
        inputString = ThisDrawing.Utility.GetInput
        MsgBox "输入的关键字是: " & inputString
    ElseIf Err.Number = -2147352567 Then
        MsgBox "右键"
        Err.Clear
    Else
        MsgBox "选择对象出错: " & Err.Description
        Err.Clear
    End If
Else
    ' 显示用户选定的对象类型
    MsgBox "你选定的对象类型为: " & ent.ObjectName, , "明经VBA示例：GetEntity及InitializeUserInput方法"
End If
[/php]

gogogo168

斑竹的代码好像不是在autocad2004下编的哦！！！我在2004下试不通

雪山飞狐(lzh)

你在If Err Then 语句下加一条：
debug.print err.number
在立即窗口看看错误码，相应的改过来就可以了

雪山飞狐(lzh)

2. 
   
3. Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
   
4. Const VK_ESCAPE = &H1B
   
5. Const VK_LBUTTON = &H1
   
6. Const VK_RBUTTON = &H2
   
7. Const VK_RETURN = &HD
   
8. Const VK_SPACE = &H20
   
9. 
   
10. Sub tt()
    
11. On Error Resume Next
    
12. 
    
13. ' 定义有效的关键字
    
14. Dim keywordList As String
    
15. keywordList = "S E"
    
16. 
    
17. ' 调用 InitializeUserInput 初始化关键字
    
18. ThisDrawing.Utility.InitializeUserInput 0, keywordList
    
19. 
    
20. ' 获得用户输入
    
21. Dim Pnt As Variant
    
22. Dim ent As AcadEntity
    
23. ThisDrawing.Utility.GetEntity ent, Pnt, "选择对象[设置(S)/删除(E)]： "
    
24. If Err Then
    
25.     If Err.Number = -2147467259 Then
    
26.         ' 当输入关键字时
    
27.         Dim inputString As String
    
28.         Err.Clear
    
29.         inputString = ThisDrawing.Utility.GetInput
    
30.         MsgBox "输入的关键字是: " & inputString
    
31.     ElseIf Err.Number = -2147352567 Then
    
32.         If GetAsyncKeyState(VK_RBUTTON) Then
    
33.             MsgBox "右键"
    
34.         ElseIf GetAsyncKeyState(VK_LBUTTON) Then
    
35.             MsgBox "空选择"
    
36.         ElseIf GetAsyncKeyState(VK_RETURN) Then
    
37.             MsgBox "回车"
    
38.         ElseIf GetAsyncKeyState(VK_SPACE) Then
    
39.             MsgBox "空格"
    
40.         ElseIf GetAsyncKeyState(VK_ESCAPE) Then
    
41.             MsgBox "Esc"
    
42.         End If
    
43.         Err.Clear
    
44.     Else
    
45.         MsgBox "选择对象出错: " & Err.Description
    
46.         Err.Clear
    
47.     End If
    
48. Else
    
49.     ' 显示用户选定的对象类型
    
50.     MsgBox "你选定的对象类型为: " & ent.ObjectName, , "明经VBA示例：GetEntity及InitializeUserInput方法"
    
51. End If
    
52. 
    
53. End Sub
    
54. 
    

<br /> Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer<br /> Const VK_ESCAPE = &H1B<br /> Const VK_LBUTTON = &H1<br /> Const VK_RBUTTON = &H2<br /> Const VK_RETURN = &HD<br /> Const VK_SPACE = &H20<br /> <br /> Sub tt()<br /> On Error Resume Next<br /> <br /> ' 定义有效的关键字<br /> Dim keywordList As String<br /> keywordList = "S E"<br /> <br /> ' 调用 InitializeUserInput 初始化关键字<br /> ThisDrawing.Utility.InitializeUserInput 0, keywordList<br /> <br /> ' 获得用户输入<br /> Dim Pnt As Variant<br /> Dim ent As AcadEntity<br /> ThisDrawing.Utility.GetEntity ent, Pnt, "选择对象[设置(S)/删除(E)]： "<br /> If Err Then<br />     If Err.Number = -2147467259 Then<br />         ' 当输入关键字时<br />         Dim inputString As String<br />         Err.Clear<br />         inputString = ThisDrawing.Utility.GetInput<br />         MsgBox "输入的关键字是: " & inputString<br />     ElseIf Err.Number = -2147352567 Then<br />         If GetAsyncKeyState(VK_RBUTTON) Then<br />             MsgBox "右键"<br />         ElseIf GetAsyncKeyState(VK_LBUTTON) Then<br />             MsgBox "空选择"<br />         ElseIf GetAsyncKeyState(VK_RETURN) Then<br />             MsgBox "回车"<br />         ElseIf GetAsyncKeyState(VK_SPACE) Then<br />             MsgBox "空格"<br />         ElseIf GetAsyncKeyState(VK_ESCAPE) Then<br />             MsgBox "Esc"<br />         End If<br />         Err.Clear<br />     Else<br />         MsgBox "选择对象出错: " & Err.Description<br />         Err.Clear<br />     End If<br /> Else<br />     ' 显示用户选定的对象类型<br />     MsgBox "你选定的对象类型为: " & ent.ObjectName, , "明经VBA示例：GetEntity及InitializeUserInput方法"<br /> End If<br /> <br /> End Sub<br /> <br />

macula55

谢谢斑竹，这个对我很有用！