Question

我有一个excel文件，列中列出了部件号。在运行时，代码将分割键入的第一个部件号。从上半部分开始，代码找到包含该部件号类别的子文件夹，然后下半部分是实际文件名。示例01T-1001-01。 01T是子文件夹名称，1001-01是文件名，它在-处分割。但是，有时会在括号中添加对零件的描述，例如1001-01 (Chuck)。这就是外卡的用途。

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

问题在于它将打开一个图形（列表中的第一个），但会出现错误，并且＃34;运行时错误＆＃39;＆＃39;：对象不支持此属性或方法＆＃34;它不会继续超过Set ACADApp.ActiveDocument = ACADApp.Documents.Open(ACADPath)以打开列表中的其他dwgs

以下更新代码：

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

Answer 1

以下是我在生产应用程序中使用的基本shell：

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

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

修改

使用上述代码作为起点并将其应用于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

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

1 个答案: