求助关于getobject的问题

forverd · 发表于 2018-7-25 16:15:00

复制代码这是我的一段代码，现在的问题是如果Cad是打开的状况下，运行到红色代码部分没有任何提示，如果cad是关闭的情况下就会提示
这个窗口。一直没找到问题出在哪里，现在不想要这个窗口提示该怎么改？谢谢！
Private Sub Main()
Dim acadapp As Object
Dim objsel As AcadSelectionSet
Dim xref As AcadExternalReference
Dim InsertPoint(0 To 2) As Double
Dim arrX()
Dim arrY()
'On Error Resume Next
Set acadapp = GetObject(, ".Application")
If Err Then
      Err.Clear
      Set acadapp = CreateObject("AutoCAD.Application")
      acadapp.Visible = True
End If
'遍历该程序所在文件夹内的所有dwg文件
Dim i, j As Integer
i = 0
mydir = Dir(App.Path & "\*.dwg", vbNormal)
Do While mydir  ""
      Set wb = GetObject(App.Path & "\" & mydir)
         If mydir = "标准图框.dwg" Then
         GoTo nextdo
      End If

sityojfiagf.jpg

yshf · 发表于 2018-7-28 08:12:00

'......
Dim AcadDoc As Object
Dim wb As Object
Set AcadDoc = acadapp.ActiveDocument

'遍历该程序所在文件夹内的所有dwg文件
Dim i, j As Integer
i = 0
mydir = Dir(App.Path & "\*.dwg", vbNormal)
Do While mydir  ""
      Set wb = AcadDoc.Open(App.Path & "\" & mydir)
      'Set wb = GetObject(App.Path & "\" & mydir)
      If mydir = "标准图框.dwg" Then
         GoTo nextdo
      End If
      '......

Loop