|
|
Option ExplicitPrivate Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Const VK_ESCAPE = &H1B
Dim acadapp As AcadApplication
Dim acaddoc As AcadDocumentPrivate Sub Form_Load()
Me.Hide
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
Set acadapp = GetObject(, ".application")
Set acaddoc = acadapp.ActiveDocument
Pnt1 = acaddoc.Utility.GetPoint(, vbCr & "选择第一点:")
Do
Pnt2 = acaddoc.Utility.GetPoint(Pnt1, vbCr & "选择下一点:")
Set line = acaddoc.ModelSpace.AddLine(Pnt1, Pnt2)
Pnt1 = Pnt2
Loop
Exit_Here:
Exit Sub
Err_Control:
varCancel = acaddoc.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
'如果按了ESC键，则退出
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 |
|
置顶卡
