使用 vba 在打开的 ACAD 应用程序中打开 ACAD dwg 文件

Opening an ACAD dwg file in opened ACAD application with vba

提问by holi4683

I have an excel file with part numbers listed in a column. On running, the code splits the first part number typed. From the first half the code finds the subfolder that contains that category of part numbers then the second half is the actual file name. Example 01T-1001-01. 01T is the subfolder name and the 1001-01is the file name, it splits at -. However sometimes descriptions of the part are added in parenthesis so for example 1001-01 (Chuck). That is what the wild card is for.

我有一个列在列中的零件号的 Excel 文件。在运行时，代码会拆分输入的第一个部件号。代码从前半部分找到包含该类别部件号的子文件夹，然后后半部分是实际文件名。例子01T-1001-01。01T 是子文件夹名，the1001-01是文件名，它在-. 但是，有时会在括号中添加零件的描述，例如1001-01 (Chuck)。这就是外卡的用途。

The code is supposed to first check if AutoCAD is opened, if so then open the dwg in the opened AutoCAD application, if not then open a new application.

该代码应该首先检查 AutoCAD 是否已打开，如果是，则在打开的 AutoCAD 应用程序中打开 dwg，如果没有，则打开一个新应用程序。

The issue is that it will open one drawing (first in the list) but will error out with "Run time error '438': Object doesn't support this property or method" It will not continue past Set ACADApp.ActiveDocument = ACADApp.Documents.Open(ACADPath)to open the other dwgs in the list

问题是它会打开一个图形（列表中的第一个），但会出现“运行时错误‘438’：对象不支持此属性或方法”Set ACADApp.ActiveDocument = ACADApp.Documents.Open(ACADPath)的错误信息。列表

UPDATED Code below:

更新代码如下：

Dim ACADApp As AcadApplication
Dim ACADPath As String
Dim ACAD As Object
Dim NFile As Object
Sub Open_Dwg()

Dim Wildcard As String
Dim path As String
Dim target As String
Dim SplitString() As String
Dim i As Integer
Dim a As Integer

i = 1

If ACAD Is Nothing Then
    Set ACAD = CreateObject("AutoCad.Application")

    If ACAD Is Nothing Then
        MsgBox "Could not start AutoCAD.", vbCritical
        Exit Sub
    End If
    Else
        Set ACAD = GetObject(, "AutoCAD.Application")
End If

Set ACADApp = ACAD
ACADApp.Visible = True

Do Until Cells(i, 1).Value = ""
ACADPath = ""
Wildcard = ""
OpenString = ""

path = "C:\Users\aholiday\Desktop\DEMO" 'Root Folder
target = Cells(i, 1).Value 'Get Targeted Cell Value
target = UCase(target) 'All Letters to Upper Case
SplitString() = Split(target, "-", 2) 'Split given name to obtain subfolder and name
path = path & "\" & SplitString(0) & "\" 'Build Complete Path

OpenString = path & SplitString(1) & ".dwg" 'File Path and Name
Wildcard = Dir(path & SplitString(1) & "*.dwg") 'File Path and Wildcard

If Dir(OpenString) <> "" Then
        ACADPath = OpenString
        OpenFile (ACADPath)
    Else
            If Wildcard <> "" Then 'If Not Then Use Wildcard
                ACADPath = path & Wildcard
                OpenFile (ACADPath)
            Else
                MsgBox ("File " & target & " Not Found")
            End If
    End If
i = i + 1
Loop
End Sub

Function OpenFile(ByVal ACADPath As String) As String
    Set ACADApp.ActiveDocument = ACADApp.Documents.Open(ACADPath)
End Function

回答by Brian M Stafford

Here is a basic shell of what I use in our production application:

这是我在生产应用程序中使用的基本外壳：

Sub Open_Dwg()
   On Error Resume Next

   Dim ACADApp As AcadApplication
   Dim a As Object

   Set a = GetObject(, "AutoCAD.Application")

   If a Is Nothing Then
      Set a = CreateObject("AutoCAD.Application")

      If a Is Nothing Then
         MsgBox "AutoCAD must be running before performing this action.", vbCritical
         Exit Sub
      End If
   End If

   Set ACADApp = a
   ACADApp.Visible = True
   Set ACADApp.ActiveDocument = ACADApp.Documents.Open("<your filename>")
End Sub

Note the modification of the GetObject call and how the document is being opened.

请注意 GetObject 调用的修改以及文档的打开方式。

EDIT:

编辑：

Using the above code as a starting point and applying it to the OP's code, you would end up with the following:

使用上面的代码作为起点并将其应用于 OP 的代码，您将得到以下结果：

Option Explicit

Dim ACADApp As AcadApplication
Dim ACADPath As String
Dim ACAD As Object
Dim NFile As Object

Sub Open_Dwg()
   Dim Wildcard As String
   Dim OpenString As String
   Dim path As String
   Dim target As String
   Dim SplitString() As String
   Dim i As Integer
   Dim a As Integer

   'get or create an instance of autocad
   On Error Resume Next
   Set ACAD = Nothing
   Set ACAD = GetObject(, "AutoCAD.Application")

   If ACAD Is Nothing Then
      Set ACAD = CreateObject("AutoCad.Application")

      If ACAD Is Nothing Then
         MsgBox "Could not start AutoCAD.", vbCritical
         Exit Sub
      End If
   End If

   Set ACADApp = ACAD
   ACADApp.Visible = True
   On Error GoTo 0

   'process files
   i = 1

   Do Until Cells(i, 1).Value = ""
      path = "C:\Users\aholiday\Desktop\DEMO" 'Root Folder
      target = UCase(Cells(i, 1).Value) 'Get Targeted Cell Value
      SplitString() = Split(target, "-", 2) 'Split given name to obtain subfolder and name
      path = path & "\" & SplitString(0) & "\" 'Build Complete Path
      OpenString = path & SplitString(1) & ".dwg" 'File Path and Name
      Wildcard = Dir(path & SplitString(1) & "*.dwg") 'File Path and Wildcard

      If Dir(OpenString) <> "" Then
         OpenFile OpenString
      Else
         If Wildcard <> "" Then 'If Not Then Use Wildcard
            OpenFile path & Wildcard
         Else
            MsgBox ("File " & target & " Not Found")
         End If
      End If

      i = i + 1
   Loop
End Sub

Function OpenFile(ByVal ACADPath As String) As String
    ACADApp.Documents.Open ACADPath
End Function