使用Excel VBA在AutoCad 2019中创建xline
我正在为AutoCad制作Excel VBA代码以创建简单的Xline 我画了圆圈和线条,但Xline在最后一刻取消了 代码将完成所有步骤,插入Xline,然后将其居中为0,0,但指定的通过点存在问题使用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
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