Fatal编程技术网
  • vba/
  • 使用vba在打开的ACAD应用程序中打开ACAD dwg文件

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

vba excel

使用vba在打开的ACAD应用程序中打开ACAD dwg文件,vba,excel,autocad,Vba,Excel,Autocad,我有一个excel文件，零件号列在一列中。运行时，代码会拆分键入的第一个零件号。代码从前半部分查找包含该类别零件号的子文件夹，然后从后半部分查找实际文件名。示例01T-1001-01。01T是子文件夹名，1001-01是文件名，它在-处拆分。但是，有时会在括号中添加零件说明，例如1001-01（卡盘）。这就是外卡的作用 代码应首先检查AutoCAD是否已打开，如果已打开，则在打开的AutoCAD应用程序中打开dwg，如果未打开，则打开新的应用程序 问题是，它将打开一个图形（列表中的第一个），但会

我有一个excel文件，零件号列在一列中。运行时，代码会拆分键入的第一个零件号。代码从前半部分查找包含该类别零件号的子文件夹，然后从后半部分查找实际文件名。示例
01T-1001-01
。01T是子文件夹名，
1001-01
是文件名，它在
-
处拆分。但是，有时会在括号中添加零件说明，例如
1001-01（卡盘）
。这就是外卡的作用

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

问题是，它将打开一个图形（列表中的第一个），但会出现“运行时错误'438'：对象不支持此属性或方法”的错误。它将不会继续运行超过
Set ACADApp.ActiveDocument=ACADApp.Documents.open（ACADPath）
以打开列表中的其他DWG

更新了下面的代码：

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

Dim ACADApp作为AcadApplication
将ACADPath设置为字符串
作为对象的Dim ACAD
作为对象的文件
子打开图（）
将通配符设置为字符串
将路径设置为字符串
将目标变暗为字符串
Dim SplitString（）作为字符串
作为整数的Dim i
将a变暗为整数
i=1
如果ACAD算不了什么，那么
设置ACAD=CreateObject（“AutoCad.Application”）
如果ACAD算不了什么，那么
MsgBox“无法启动AutoCAD”，vbCritical
出口接头
如果结束
其他的
设置ACAD=GetObject（，“AutoCAD.Application”）
如果结束
设置ACADApp=ACAD
ACADApp.Visible=True
直到单元格（i，1）为止。Value=“”
ACADPath=“”
通配符=“”
OpenString=“”
path=“C:\Users\aholiday\Desktop\DEMO”'根文件夹
目标=单元格（i，1）。值“获取目标单元格值”
target=UCase（target）'所有字母大写
SplitString（）=拆分（目标“-”，2）“拆分给定名称以获取子文件夹和名称
path=path&“\”&SplitString（0）&“\”生成完整路径
OpenString=path&SplitString（1）&“.dwg””文件路径和名称
通配符=Dir（路径和拆分字符串（1）&“*.dwg”）'文件路径和通配符
如果Dir（OpenString）“，则
ACADPath=OpenString
OpenFile（ACADPath）
其他的
如果为通配符“”，则为“”，如果不是，则使用通配符
ACADPath=路径和通配符
OpenFile（ACADPath）
其他的
MsgBox（“文件”&目标&“未找到”）
如果结束
如果结束
i=i+1
环
端接头
函数OpenFile（ByVal ACADPath作为字符串）作为字符串
设置ACADApp.ActiveDocument=ACADApp.Documents.Open（ACADPath）
端函数
以下是我在生产应用程序中使用的基本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

Sub Open_Dwg（）
出错时继续下一步
Dim ACADApp作为AcadApplication
使物体变暗
设置a=GetObject（，“AutoCAD.Application”）
如果a什么都不是
设置a=CreateObject（“AutoCAD.Application”）
如果a什么都不是
MsgBox“执行此操作前必须运行AutoCAD”，vbCritical
出口接头
如果结束
如果结束
设置ACADAP=a
ACADApp.Visible=True
设置ACADApp.ActiveDocument=ACADApp.Documents.Open（“”）
端接头
注意GetObject调用的修改以及文档的打开方式

编辑：

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

选项显式
Dim ACADApp作为AcadApplication
将ACADPath设置为字符串
作为对象的Dim ACAD
作为对象的文件
子打开图（）
将通配符设置为字符串
将OpenString设置为字符串
将路径设置为字符串
将目标变暗为字符串
Dim SplitString（）作为字符串
作为整数的Dim i
将a变暗为整数
'获取或创建autocad实例
出错时继续下一步
设置ACAD=无
设置ACAD=GetObject（，“AutoCAD.Application”）
如果ACAD算不了什么，那么
设置ACAD=CreateObject（“AutoCad.Application”）
如果ACAD算不了什么，那么
MsgBox“无法启动AutoCAD”，vbCritical
出口接头
如果结束
如果结束
设置ACADApp=ACAD
ACADApp.Visible=True
错误转到0
'处理文件
i=1
直到单元格（i，1）为止。Value=“”
path=“C:\Users\aholiday\Desktop\DEMO”'根文件夹
target=UCase（单元格（i，1）.Value）'获取目标单元格值
SplitString（）=拆分（目标“-”，2）“拆分给定名称以获取子文件夹和名称
path=path&“\”&SplitString（0）&“\”生成完整路径
OpenString=path&SplitString（1）&“.dwg””文件路径和名称
通配符=Dir（路径和拆分字符串（1）&“*.dwg”）'文件路径和通配符
如果Dir（OpenString）“，则
OpenFile OpenString
其他的
如果为通配符“”，则为“”，如果不是，则使用通配符
OpenFile路径和通配符
其他的
MsgBox（“文件”&目标&“未找到”）
如果结束
如果结束
i=i+1
环
端接头
函数OpenFile（ByVal ACADPath作为字符串）作为字符串
ACADApp.Documents.Open ACADPath
端函数
Autocad中的“打开”命令不是这样吗
Application.Documents.Open sFilename
idk，让我试试。。。。Nopedoesn不喜欢
Set ACAD=GetObject（，“ACAD.Application”）
如果我将
Set ACAD=GetObject（，“ACAD.Application”）
移动到
else
之后的If语句中，则ActiveX组件无法创建对象，然后我会得到“无效文件名”。我在
Set ACADApp.ActiveDocument=ACADApp.Documents.Open（“”）中使用文件路径加上文件名和.dwq。您的“ACAD.Application”程序ID不正确。它应该是“AutoCAD.Application”。好的，我在路径中有一个额外的“\”。作品因此，它可以工作并打开图形，但会出现“Object不支持此属性或方法”的错误，但会打开文件。它会阻止其他DWG在循环中打开