excel - 使用 Excel VBA 在 AutoCAD 2019 中创建 Xlines

Question

我正在为 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

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