- 积分
- 17084
- 明经币
- 个
- 注册时间
- 2003-2-26
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Const VK_ESCAPE = &H1B
Dim acadapp As AcadApplication
Dim acaddoc As AcadDocument
Private 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(, "AutoCAD.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 |
|