请问：用getpoint操作时，怎样进行平移缩放及右键结束
本帖最后由 mccad 于 2003-4-7 20:42:27 编辑我用getpoint操作时，用时要进行缩放，它就提示出错，请问用什么方法解决。
有时我要连续用getpoint取点，怎么才能让它判断我按了右键，要结束getpoint了
如以下过程...
本帖最后由 作者 于 2006-2-12 14:23:45 编辑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
谢谢
真不知道如何感激才好，谢谢版主，谢谢mjtd佩服
佩服，斑竹真是个高手，佩服版主，我认为你上面的过程中有一个错误!
If InStr(1, varCancel, "*Cancel*") <> 0 And InStr(1, varCancel, "*取消*") <> 0 Then句中And 应为Or
但如果这样的话就达不到目的了
这是一个小问题！里面还有一个问题
取消命令和其他透明命令的错误码是-2147467259 而非-2147352567 ,上面的那段代码运行后按取消没有办法退出，空格可以~~现在只能用这个办法先，等水平高点再完善！
on error goto err..
..
....
exit sub
err:
resume
然后在右键事件中写end
就可以达到基本的效果，唯一就是没有办法用ESC键结束程序运行，要改用右键！
完整的版本如下(利用了API增加对ESC键的判断)
本帖最后由 mccad 于 2003-4-18 20:42:53 编辑以下为程序部分：
On Error GoTo Err_Control
Dim Pnt1 As Variant
Dim Pnt2 As Variant
Dim line As AcadLine
Dim varCancel As Variant
hHook = SetWindowsHookEx(WH_KEYBOARD, _
AddressOf KeyboardProc, 0&, 0)
Pnt1 = ThisDrawing.Utility.GetPoint(, vbCr & "选择第一点：")
Do
Pnt2 = ThisDrawing.Utility.GetPoint(Pnt1, vbCr & "选择下一点:")
Set line = ThisDrawing.ModelSpace.AddLine(Pnt1, Pnt2)
Pnt1 = Pnt2
Loop
Exit_Here:
Call UnhookWindowsHookEx(hHook)
Exit Sub
Err_Control:
Select Case Err.Number
Case -2147352567
'按了取消键或其它透明命令
If EscKey = True 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
以下为模块部分：
Public Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Public Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Public Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Const WH_KEYBOARD = 2
Public Const KBH_MASK = &H20000000
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Global hHook As Long
Global EscKey As Boolean
Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
If nCode >= 0 Then
'Process keys you want to filter
If wParam = 27 Then
EscKey = True
Else
EscKey = False
End If
End If
KeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam)
End Function