明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1292|回复: 0

VBA中功能都可以实现,但在VB中还是没有办法捕捉,见代码!

[复制链接]
发表于 2003-12-23 20:30:00 | 显示全部楼层 |阅读模式
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
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-28 11:00 , Processed in 0.168470 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表