tfyyf 发表于 2003-4-21 14:17:00

高手就是高手~~~~~~

arej 发表于 2003-4-28 13:47:00

似乎有点问题？

请教版主，我试着使用了您的方法，为什么陷入了死循环？
只是把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 发表于 2003-6-8 20:35:00

[疑问]有问题，陷入死循环！

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

3kd 发表于 2003-6-15 12:08:00

有点问题？

怎么在
case else　
masbox()

那里好象也有死循环？

南子 发表于 2003-6-18 09:30:00

ThisDrawing.SendCommand "(getpoint " & Chr(34) & "\npoint:" & Chr(34) &

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

winddeity 发表于 2003-7-25 13:40:00

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

南子 发表于 2003-8-5 09:08:00

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 发表于 2003-8-28 13:26:00

现在使用了南子说的API函数，解决这个问题
'判断某一键盘键自上次调用该函数以来是否被按过的API函数
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Const VK_ESCAPE = &H1B

Sub DrawLine()
    Dim ESC As Long
    GetAsyncKeyState VK_ESCAPE
    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:
    varCancel = ThisDrawing.GetVariable("LASTPROMPT")
    ESC = GetAsyncKeyState(VK_ESCAPE)
    Select Case Err.Number
      '按了取消键或其它透明命令
      Case -2147352567
            '如果命令行提示中没有“取消”这样的文字出现
            '一般来说在2002中按了回车或空格都不会出现“取消”
            '则退出
            If InStr(1, varCancel, "*Cancel*") <> 0 And _
               InStr(1, varCancel, "*取消*") <> 0 Then
                Err.Clear
                Resume Exit_Here
            '如果按了“取消”键，则退出
            ElseIf ESC <> 0 Then
                Err.Clear
                Resume Exit_Here
            '其它情况下，则恢复。如选择了透明命令，则会出现“取消”
            '字样，但不是按了“取消”键。
            Else
                Err.Clear
                Resume
            End If
      '右键单击或回车或空格。
      '在这里，-2147467259用于AutoCAD 2000 及2002，
      '而-2145320928为2004专用
      Case -2147467259, -2145320928
            Err.Clear
            Resume Exit_Here
      '其它情况，一律退出
      Case Else
            Err.Clear
            Resume Exit_Here
    End Select
End Sub

bluemoon 发表于 2003-8-30 09:33:00

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

lei_jinbo 发表于 2003-9-12 16:21:00

对呀,我用14版本,好像编译通不过.
页: 1 [2] 3 4 5
查看完整版本: 请问：用getpoint操作时，怎样进行平移缩放及右键结束