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

tfyyf

arej

请教版主，我试着使用了您的方法，为什么陷入了死循环？
只是把Pnt1 = ThisDrawing.Utility.GetPoint(, vbCrlf & "选择第一点：") 改成了Number = ThisDrawing.Utility.GetInteger(, vbCr & "选择第一点：") 。
然后程序一直在循环Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long,ByVal lParam As Long) As Long 函数。
请教！！谢谢！！

arej

请教mccad版主，我试了您的程序，在执行Pnt1 = ThisDrawing.Utility.GetPoint(, vbCr & "选择第一点：") 时调用Function KeyboardProc函数，但在此函数里一直循环执行，不能跳出，不知您是否碰到该情况？会否是本程序有误？
请指教！

3kd

怎么在
case else　
masbox()

那里好象也有死循环？

南子

ThisDrawing.SendCommand "(getpoint " & Chr(34) & "\npoint:" & Chr(34) & " )" & Chr(13)[br]

winddeity

能解释一下吗？主要是API那部分

南子

acadx中有一个getxx.dll，它可以很好地解决这个问题。它主要使用的API如下
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Public Const VK_ESCAPE = &H1B
Public Const VK_LBUTTON = &H1
Public Const VK_RBUTTON = &H2
Public Const VK_RETURN = &HD
Public Const VK_SPACE = &H20
Public Const PI = 3.141592654

Public Const GETXX_SUCCESS = &H1
Public Const GETXX_ESCAPE = &H2
Public Const GETXX_RBUTTON = &H4
Public Const GETXX_RETURN = &H8
Public Const GETXX_KEYWORD = &H10
Public Const GETXX_TOOLBAR = &H20
Public Const GETXX_NOPICK = &H40
Public Const GETXX_ACADRETURN = GETXX_RBUTTON Or GETXX_RETURN
Public Const GETXX_FAILED = GETXX_ESCAPE Or GETXX_RBUTTON Or GETXX_RETURN Or GETXX_NOPICK
'IF A KEYWORD LIST IS SUPPLIED, THE ONLY ERROR CODES THAT CAN BE RETURNED ARE:
'GETXX_SUCCESS, GETXX_ESCAPE, & GETXX_KEYWORD

mccad

现在使用了南子说的API函数，解决这个问题

2. '判断某一键盘键自上次调用该函数以来是否被按过的API函数
   
3. Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
   
4. 
   
5. Private Const VK_ESCAPE = &H1B
   
6. 
   
7. Sub DrawLine()
   
8.     Dim ESC As Long
   
9.     GetAsyncKeyState VK_ESCAPE
   
10.     On Error GoTo Err_Control
    
11.     Dim Pnt1 As Variant
    
12.     Dim Pnt2 As Variant
    
13.     Dim line As AcadLine
    
14.     Dim varCancel As Variant
    
15.     Pnt1 = ThisDrawing.Utility.GetPoint(, vbCr & "选择第一点:")
    
16.    
    
17.     Do
    
18.         Pnt2 = ThisDrawing.Utility.GetPoint(Pnt1, vbCr & "选择下一点:")
    
19.         Set line = ThisDrawing.ModelSpace.AddLine(Pnt1, Pnt2)
    
20.         Pnt1 = Pnt2
    
21.     Loop
    
22. 
    
23. Exit_Here:
    
24.   Exit Sub
    
25. Err_Control:
    
26.     varCancel = ThisDrawing.GetVariable("LASTPROMPT")
    
27.     ESC = GetAsyncKeyState(VK_ESCAPE)
    
28.     Select Case Err.Number
    
29.         '按了取消键或其它透明命令
    
30.         Case -2147352567
    
31.             '如果命令行提示中没有“取消”这样的文字出现
    
32.             '一般来说在2002中按了回车或空格都不会出现“取消”
    
33.             '则退出
    
34.             If InStr(1, varCancel, "*Cancel*") <> 0 And _
    
35.                InStr(1, varCancel, "*取消*") <> 0 Then
    
36.                 Err.Clear
    
37.                 Resume Exit_Here
    
38.             '如果按了“取消”键，则退出
    
39.             ElseIf ESC <> 0 Then
    
40.                 Err.Clear
    
41.                 Resume Exit_Here
    
42.             '其它情况下，则恢复。如选择了透明命令，则会出现“取消”
    
43.             '字样，但不是按了“取消”键。
    
44.             Else
    
45.                 Err.Clear
    
46.                 Resume
    
47.             End If
    
48.         '右键单击或回车或空格。
    
49.         '在这里，-2147467259用于AutoCAD 2000 及2002，
    
50.         '而-2145320928为2004专用
    
51.         Case -2147467259, -2145320928
    
52.             Err.Clear
    
53.             Resume Exit_Here
    
54.         '其它情况，一律退出
    
55.         Case Else
    
56.             Err.Clear
    
57.             Resume Exit_Here
    
58.     End Select
    
59. End Sub
    

'判断某一键盘键自上次调用该函数以来是否被按过的API函数<br /> Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer<br /> <br /> Private Const VK_ESCAPE = &H1B<br /> <br /> Sub DrawLine()<br />     Dim ESC As Long<br />     GetAsyncKeyState VK_ESCAPE<br />     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 />     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 />   Exit Sub<br /> Err_Control:<br />     varCancel = ThisDrawing.GetVariable("LASTPROMPT")<br />     ESC = GetAsyncKeyState(VK_ESCAPE)<br />     Select Case Err.Number<br />         '按了取消键或其它透明命令<br />         Case -2147352567<br />             '如果命令行提示中没有“取消”这样的文字出现<br />             '一般来说在2002中按了回车或空格都不会出现“取消”<br />             '则退出<br />             If InStr(1, varCancel, "*Cancel*") <> 0 And _<br />                InStr(1, varCancel, "*取消*") <> 0 Then<br />                 Err.Clear<br />                 Resume Exit_Here<br />             '如果按了“取消”键，则退出<br />             ElseIf ESC <> 0 Then<br />                 Err.Clear<br />                 Resume Exit_Here<br />             '其它情况下，则恢复。如选择了透明命令，则会出现“取消”<br />             '字样，但不是按了“取消”键。<br />             Else<br />                 Err.Clear<br />                 Resume<br />             End If<br />         '右键单击或回车或空格。<br />         '在这里，-2147467259用于AutoCAD 2000 及2002，<br />         '而-2145320928为2004专用<br />         Case -2147467259, -2145320928<br />             Err.Clear<br />             Resume Exit_Here<br />         '其它情况，一律退出<br />         Case Else<br />             Err.Clear<br />             Resume Exit_Here<br />     End Select<br /> End Sub<br />

bluemoon

hHook = SetWindowsHookEx(WH_KEYBOARD, _
                            AddressOf KeyboardProc, 0&, 0)
此句是否有错
我在编译时 出现“编译错误：缺少表达式”   这是怎么会事啊？
还请斑竹指点

lei_jinbo

对呀,我用14版本,好像编译通不过.