使用Excel VBA在AutoCad 2019中创建xline

使用Excel VBA在AutoCad 2019中创建xline,excel,vba,autocad,Excel,Vba,Autocad,我正在为AutoCad制作Excel VBA代码以创建简单的Xline 我画了圆圈和线条,但Xline在最后一刻取消了 代码将完成所有步骤,插入Xline,然后将其居中为0,0,但指定的通过点存在问题 Sub xline() Set wshShell = VBA.CreateObject("wscript.shell") SetCursorPos 300, 300 SetCursorPos 600, 990 Call Left

我正在为AutoCad制作Excel VBA代码以创建简单的Xline

我画了圆圈和线条,但Xline在最后一刻取消了

代码将完成所有步骤,插入Xline,然后将其居中为0,0,但指定的通过点存在问题

Sub xline()

    Set wshShell = VBA.CreateObject("wscript.shell")

    SetCursorPos 300, 300
    SetCursorPos 600, 990
      
    Call LeftClick
      
    Application.Wait (Now + TimeValue("0:00:01"))
    
    wshShell.SendKeys "xline"
    wshShell.SendKeys "{ENTER}"

    Application.Wait (Now + TimeValue("0:00:2"))

    wshShell.SendKeys "v"
    wshShell.SendKeys "~"

    Application.Wait (Now + TimeValue("0:00:2"))

    wshShell.SendKeys "0,0"
    
    'Application.Wait (Now + TimeValue("0:00:2"))

    wshShell.SendKeys "~"

    'Application.Wait (Now + TimeValue("0:00:02"))
    'wshShell.SendKeys "1"
    'Application.Wait (Now + TimeValue("0:00:2"))
    'wshShell.SendKeys "{TAB}"
    'wshShell.SendKeys "90"
    'Application.Wait (Now + TimeValue("0:00:2"))
    'wshShell.SendKeys "{TAB}"
    'wshShell.SendKeys "{ENTER}"

     wshShell.SendKeys "{ESC}"

End Sub

与其使用WSH向AutoCAD应用程序发出击键并依赖于交互时间,为什么不直接与AutoCAD对象模型交互

下面是一些非常粗略的代码,可以帮助您朝着正确的方向前进:

Sub XLine()
    Dim acApp As Object
    Dim acDoc As Object
    Dim arrBpt(0 To 2) As Double
    Dim arrVec(0 To 2) As Double

    On Error Resume Next
    Set acApp = GetObject(, "AutoCAD.Application")
    If Err Then
        On Error GoTo error_handler
        Set acApp = CreateObject("AutoCAD.Application")
    End If
    On Error GoTo error_handler
    If acApp.Documents.Count = 0 Then
        Set acDoc = acApp.Documents.Add
    Else
        Set acDoc = acApp.ActiveDocument
    End If

    arrVec(0) = 0: arrVec(1) = 1: arrVec(2) = 0
    acDoc.ModelSpace.AddXline arrBpt, arrVec
    acApp.Visible = True

error_handler:
    If Not acApp Is Nothing Then Set acApp = Nothing
End Sub