请问：用getpoint操作时，怎样进行平移缩放及右键结束

zgyxn

我用getpoint操作时，用时要进行缩放，它就提示出错，请问用什么方法解决。
有时我要连续用getpoint取点，怎么才能让它判断我按了右键，要结束getpoint了

mccad

2. Sub GetPnt()
3. On Error GoTo Err_Control
4.     Dim Pnt1 As Variant
5.     Dim Pnt2 As Variant
6.     Dim line As AcadLine
7.     Dim varCancel As Variant
8.     Pnt1 = ThisDrawing.Utility.GetPoint(, vbCr & "选择第一点：")
9.    
10.     Do
11.         Pnt2 = ThisDrawing.Utility.GetPoint(Pnt1, vbCr & "选择下一点:")
12.         Set line = ThisDrawing.ModelSpace.AddLine(Pnt1, Pnt2)
13.         Pnt1 = Pnt2
14.     Loop
16. Exit_Here:
17.   Exit Sub
18. Err_Control:
19.   Select Case Err.Number
20.     Case -2147352567
21.     '按了取消键或其它透明命令
22.       varCancel = ThisDrawing.GetVariable("LASTPROMPT")
23.       If InStr(1, varCancel, "*Cancel*") <> 0 And InStr(1, varCancel, "*取消*") <> 0 Then
24.         Err.Clear
25.         Resume Exit_Here
26.       Else
27.         Err.Clear
28.         Resume
29.       End If
30.     Case -2147467259
31.     '右键单击或回车或空格
32.       Err.Clear
33.       Resume Exit_Here
34.     Case Else
35.       MsgBox Err.Number & Err.Description
36.       Err.Clear
37.       Resume Exit_Here
38.   End Select
39. End Sub

Sub GetPnt() On Error GoTo Err_Control     Dim Pnt1 As Variant     Dim Pnt2 As Variant     Dim line As AcadLine     Dim varCancel As Variant     Pnt1 = ThisDrawing.Utility.GetPoint(, vbCr & "选择第一点：")         Do         Pnt2 = ThisDrawing.Utility.GetPoint(Pnt1, vbCr & "选择下一点:")         Set line = ThisDrawing.ModelSpace.AddLine(Pnt1, Pnt2)         Pnt1 = Pnt2     Loop Exit_Here:   Exit Sub Err_Control:   Select Case Err.Number     Case -2147352567     '按了取消键或其它透明命令       varCancel = ThisDrawing.GetVariable("LASTPROMPT")       If InStr(1, varCancel, "*Cancel*") <> 0 And InStr(1, varCancel, "*取消*") <> 0 Then         Err.Clear         Resume Exit_Here       Else         Err.Clear         Resume       End If     Case -2147467259     '右键单击或回车或空格       Err.Clear       Resume Exit_Here     Case Else       MsgBox Err.Number & Err.Description       Err.Clear       Resume Exit_Here   End Select End Sub

zgyxn

真不知道如何感激才好，谢谢版主，谢谢mjtd

nxy_918

佩服，斑竹真是个高手，佩服

tfyyf

If InStr(1, varCancel, "*Cancel*") <> 0 And InStr(1, varCancel, "*取消*") <> 0 Then

句中And 应为Or

mccad

myfreemind

取消命令和其他透明命令的错误码是-2147467259 而非-2147352567 ,上面的那段代码运行后按取消没有办法退出，空格可以~~

myfreemind

on error goto err
..
..
....
exit sub
err:
resume

然后在右键事件中写end
就可以达到基本的效果，唯一就是没有办法用ESC键结束程序运行，要改用右键！

mccad

以下为程序部分：

2. On Error GoTo Err_Control
   
3.     Dim Pnt1 As Variant
   
4.     Dim Pnt2 As Variant
   
5.     Dim line As AcadLine
   
6.     Dim varCancel As Variant
   
7.     hHook = SetWindowsHookEx(WH_KEYBOARD, _
   
8.                             AddressOf KeyboardProc, 0&, 0)
   
9.     Pnt1 = ThisDrawing.Utility.GetPoint(, vbCr & "选择第一点：")
   
10.    
    
11.     Do
    
12.         Pnt2 = ThisDrawing.Utility.GetPoint(Pnt1, vbCr & "选择下一点:")
    
13.         Set line = ThisDrawing.ModelSpace.AddLine(Pnt1, Pnt2)
    
14.         Pnt1 = Pnt2
    
15.     Loop
    
16. 
    
17. Exit_Here:
    
18.   Call UnhookWindowsHookEx(hHook)
    
19.   Exit Sub
    
20. Err_Control:
    
21.   Select Case Err.Number
    
22.     Case -2147352567
    
23.     '按了取消键或其它透明命令
    
24.       If EscKey = True Then
    
25.         Err.Clear
    
26.         Resume Exit_Here
    
27.       Else
    
28.         Err.Clear
    
29.         Resume
    
30.       End If
    
31.     Case -2147467259
    
32.     '右键单击或回车或空格
    
33.       Err.Clear
    
34.       Resume Exit_Here
    
35.     Case Else
    
36.       MsgBox Err.Number & Err.Description
    
37.       Err.Clear
    
38.       Resume Exit_Here
    
39.   End Select
    
40. End Sub

On Error GoTo Err_Control<br />     Dim Pnt1 As Variant<br />     Dim Pnt2 As Variant<br />     Dim line As AcadLine<br />     Dim varCancel As Variant<br />     hHook = SetWindowsHookEx(WH_KEYBOARD, _<br />                             AddressOf KeyboardProc, 0&, 0)<br />     Pnt1 = ThisDrawing.Utility.GetPoint(, vbCr & "选择第一点：")<br />     <br />     Do<br />         Pnt2 = ThisDrawing.Utility.GetPoint(Pnt1, vbCr & "选择下一点:")<br />         Set line = ThisDrawing.ModelSpace.AddLine(Pnt1, Pnt2)<br />         Pnt1 = Pnt2<br />     Loop<br /> <br /> Exit_Here:<br />   Call UnhookWindowsHookEx(hHook)<br />   Exit Sub<br /> Err_Control:<br />   Select Case Err.Number<br />     Case -2147352567<br />     '按了取消键或其它透明命令<br />       If EscKey = True Then<br />         Err.Clear<br />         Resume Exit_Here<br />       Else<br />         Err.Clear<br />         Resume<br />       End If<br />     Case -2147467259<br />     '右键单击或回车或空格<br />       Err.Clear<br />       Resume Exit_Here<br />     Case Else<br />       MsgBox Err.Number & Err.Description<br />       Err.Clear<br />       Resume Exit_Here<br />   End Select<br /> End Sub

以下为模块部分：

2. Public Declare Function CallNextHookEx Lib "user32" _
   
3.    (ByVal hHook As Long, _
   
4.    ByVal nCode As Long, _
   
5.    ByVal wParam As Long, _
   
6.    ByVal lParam As Long) As Long
   
7. 
   
8. Public Declare Function UnhookWindowsHookEx Lib "user32" _
   
9.    (ByVal hHook As Long) As Long
   
10. 
    
11. Public Declare Function SetWindowsHookEx Lib "user32" _
    
12.    Alias "SetWindowsHookExA" _
    
13.    (ByVal idHook As Long, _
    
14.    ByVal lpfn As Long, _
    
15.    ByVal hmod As Long, _
    
16.    ByVal dwThreadId As Long) As Long
    
17. 
    
18. Public Declare Function PostMessage Lib "user32" _
    
19.    Alias "PostMessageA" _
    
20.    (ByVal hwnd As Long, _
    
21.    ByVal wMsg As Long, _
    
22.    ByVal wParam As Long, _
    
23.    ByVal lParam As Long) As Long
    
24. 
    
25. Public Const WH_KEYBOARD = 2
    
26. Public Const KBH_MASK = &H20000000
    
27. Public Const WM_LBUTTONDOWN = &H201
    
28. Public Const WM_LBUTTONUP = &H202
    
29. 
    
30. Global hHook As Long
    
31. Global EscKey As Boolean
    
32. 
    
33. Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long, _
    
34.                               ByVal lParam As Long) As Long
    
35.    If nCode >= 0 Then
    
36.    'Process keys you want to filter
    
37.       If wParam = 27 Then
    
38.          EscKey = True
    
39.       Else
    
40.         EscKey = False
    
41.       End If
    
42.    End If
    
43.    KeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam)
    
44. End Function
    

Public Declare Function CallNextHookEx Lib "user32" _<br />    (ByVal hHook As Long, _<br />    ByVal nCode As Long, _<br />    ByVal wParam As Long, _<br />    ByVal lParam As Long) As Long<br /> <br /> Public Declare Function UnhookWindowsHookEx Lib "user32" _<br />    (ByVal hHook As Long) As Long<br /> <br /> Public Declare Function SetWindowsHookEx Lib "user32" _<br />    Alias "SetWindowsHookExA" _<br />    (ByVal idHook As Long, _<br />    ByVal lpfn As Long, _<br />    ByVal hmod As Long, _<br />    ByVal dwThreadId As Long) As Long<br /> <br /> Public Declare Function PostMessage Lib "user32" _<br />    Alias "PostMessageA" _<br />    (ByVal hwnd As Long, _<br />    ByVal wMsg As Long, _<br />    ByVal wParam As Long, _<br />    ByVal lParam As Long) As Long<br /> <br /> Public Const WH_KEYBOARD = 2<br /> Public Const KBH_MASK = &H20000000<br /> Public Const WM_LBUTTONDOWN = &H201<br /> Public Const WM_LBUTTONUP = &H202<br /> <br /> Global hHook As Long<br /> Global EscKey As Boolean<br /> <br /> Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long, _<br />                               ByVal lParam As Long) As Long<br />    If nCode >= 0 Then<br />    'Process keys you want to filter<br />       If wParam = 27 Then<br />          EscKey = True<br />       Else<br />         EscKey = False<br />       End If<br />    End If<br />    KeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam)<br /> End Function<br />

myfreemind