我正在尝试通过VBA执行以下操作：
但是，实际上，我需要了解的是如何打开图形并向其发送命令。我还没有成功。
我知道AutoCAD Document Object Documentation，并尝试了 SendCommand 和 PostCommand ，但是我发现对象不支持自动化错误...有人可以告诉我我在做什么错吗？
预先感谢，拉斐尔。
编辑： 这是我正在尝试的代码：
Private Sub CenterDWG_Click()
'Me.DrawingFrame.Object.Open
Me.DrawingFrame.Object.SendCommand ("_CleanScreenON")
Me.DrawingFrame.Object.SendCommand ("._ZOOM All")
'Me.DrawingFrame.Object.Regen acAllViewports
End Sub
答案 0 :(得分：0)
如果通过外部程序控制autocad，则必须首先设置autocad对象 那么您就可以访问其属性
Public Sub startCommandInAcad()
Dim tAcadApp As AcadApplication
Set tAcadApp = getAcadApp
If (tAcadApp Is Nothing) Then
Call MsgBox("No AcadApplication found")
Else
If (tAcadApp.ActiveDocument Is Nothing) Then
Call MsgBox("No current Drawing found in AutoCAD-Application")
Else
On Error Resume Next
tAcadApp.ActiveDocument.SendCommand ("_-LANDXMLOUT" & vbCr &
"C:\TEMP\ExpFile.XML" & vbCr)
If Err.Number <> 0 Then
Call MsgBox("Error occured during 'SendCommand'" & vbNewLine &
Err.Description)
End If
On Error Goto 0
End If
End If
End Sub
答案 1 :(得分：0)
我知道这很旧，但是我有一个为此开发的应用程序。下面，我采用了一些代码并将其添加以供参考。我试图尽可能地对其进行清理，但是我确信这里缺少功能。如果您还有其他问题，请随时提出。
此代码来自的应用程序是我们在此处开发的访问数据库。它保存着我们每一个常绿的AutoCAD图形的记录。它具有子表，用于存储带有支持文档（PDF红线）的修订条目，块参考信息，块属性参考信息，自定义工程图属性和层信息。它的作用远不止于此，但这是另一个主题。
我还使用了后期绑定，而不是直接引用AutoCAD，因为我们有不同版本的用户。这更难编写代码，但可以实现相同的目标。
最后，我是一个自学成才的程序员，而且我知道我的代码并不完美，但是它可以作为满足我们需求的理想解决方案。任何建议表示赞赏和欢迎。我希望这对找到该主题的人有所帮助。
Private Sub TxtSketchURL_Click()
On Error GoTo ErrorHandler
SketchPath = "C:\Test.dwg" '<---Provide your autocad path here
Call getCadDwg(SketchPath)
'-------------------------------------------------------
ExitHere:
On Error Resume Next
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure TxtSketchURL_Click of VBA Document Form_Sketch", vbOKOnly
GoTo ExitHere
End Sub
Public Sub getCadDwg(Dwgpath As String)
On Error GoTo ErrorHandler
Dim strMsg As String
Dim booYouHaveItOpen As Boolean
Set CADApp = GetCad
Dim booFileOpen As Boolean
booFileOpen = isFileOpen(Dwgpath)
Dim booFileExists As Boolean
Dim objfso As New Scripting.FileSystemObject
booFileExists = objfso.fileExists(Dwgpath)
'See if the file exists and then exit if it doesn't
If booFileExists = False Then
MsgBox "A file at the below path does not exist." & vbCr & vbCr & vbCr & Dwgpath, vbOKOnly, "File Missing"
End If
If booFileOpen = True Then
'Search to see if it is the current user that has it opened
If CADApp.Documents.Count > 0 Then
For Each myDwg In CADApp.Documents
'Test to see if one of the current drawing has the same path, then bring it to the front.
If Dwgpath = myDwg.FullName Or GetUNC(Dwgpath) = myDwg.FullName Then
booYouHaveItOpen = True
If myDwg.active = False Then
myDwg.Activate
Call bringCADToFront
Exit For
End If
End If
Next myDwg
End If
If booYouHaveItOpen = False Then
MsgBox "Drawing file is already opened by another user." _
, vbInformation + vbOKOnly _
, "Drawing Opened Already!"
End If
GoTo ExitHere
Else
'Open the AutoCAD drawing
Set myDwg = CADApp.Documents.Open(Dwgpath)
CADApp.ZoomExtents
CADApp.Visible = True
End If
'-------------------------------------------------------
ExitHere:
On Error Resume Next
Call bringCADToFront
Set CADApp = Nothing
Set myDwg = Nothing
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure getCadDwg of Module mCadLateBind", vbOKOnly
GoTo ExitHere
End Sub
Public Function GetCad() As Object
On Error Resume Next
'Check to see if AutoCAD is open
'Set GetCad = GetObject(, "AutoCAD.Application.19")
Set GetCad = GetObject(, "AutoCAD.Application")
'If AutoCAD is NOT open and error number will be produced
If Err.Number <> 0 Then
Err.Clear
'Open an instance of AutoCAD
'Set GetCad = CreateObject("AutoCAD.Application.19")
Set GetCad = CreateObject("AutoCAD.Application")
End If
'Make AutoCAD visible
GetCad.Visible = True
End Function
Public Function GetUNC(strMappedDrive As String) As String
Dim objfso As FileSystemObject
Dim objDrive As Drive
Dim strDrive As String
Dim strShare As String
On Error GoTo ErrorHandler
Set objfso = New FileSystemObject
'Get the Drive Name
strDrive = objfso.GetDriveName(strMappedDrive)
Set objDrive = objfso.GetDrive(strDrive)
'find the UNC share name from the mapped letter
strShare = objDrive.ShareName
'Replace the MappedDrive With the UNC share name
GetUNC = Replace(strMappedDrive, strDrive, strShare)
'-------------------------------------------------------
ExitHere:
On Error Resume Next
Set objfso = Nothing 'Destroy the object
Set objDrive = Nothing 'Destroy the object
Exit Function
ErrorHandler:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetUNC of Module mFunctions", vbOKOnly
GoTo ExitHere
End Function
Public Sub bringCADToFront()
On Error GoTo ErrorHandler
Dim CADApp As Variant
Dim lngHwnd As Long
Dim lngMDIHwnd As Long
On Error GoTo ErrorHandler
Set CADApp = GetCad
lngHwnd = FindWindow(vbNullString, CADApp.Caption)
SetFocusAPI lngHwnd
'-------------------------------------------------------
ExitHere:
On Error Resume Next
Set CADApp = Nothing
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure bringCADToFront of Sub mAutoCADsubs", vbOKOnly
GoTo ExitHere
End Sub
myDwg.Close True 'True to save the drawing, False for no save