VBA Excel Создание Xlines в Autocad 2019 не работает

Question

Я делаю код для VBA Excel, который перейдет в мой autocad и создаст простой Xline.Я сделал круги, используя VBA, и линии, но 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

Answer 1

Вместо того, чтобы использовать 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