[编程交流] vb代码在au中打开图形

Dim DwgName As String
       On Error Resume Next
       Set acadApp = GetObject(, "AutoCAD.Application")
       If Err Then
           Set acadApp = CreateObject("AutoCAD .Application")
           Err.Clear
       End If
'        If Right(App.Path, 1) = "" Then
'            DwgName = "C:\13027167-GX2.dwg"
'        Else
'            DwgName = "C:\13027167-GX2.dwg"
'        End If
       Set acadDoc = acadApp.ActiveDocument
       If acadDoc.FullName <> DwgName Then
           acadDoc.Open DwgName
       End If
       Dim str As String, str1 As String
       str1 = "_-insert" & vbLf & """" & "C:\14001120-AA8232-AC8232-AZ665.dwg" & """" & vbLf & "0,0,0" & vbLf & vbLf & vbLf & vbLf & "z" & vbLf & "a" & vbLf
       'str = "dwin" & vbLf
       acadDoc.SendCommand str1
      ' acadDoc.SendCommand str
       acadApp.Visible = True

Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
                   ByVal hwnd As Long, _
                   ByVal lpOperation As String, _
                   ByVal lpFile As String, _
                   ByVal lpParameters As String, _
                   ByVal lpDirectory As String, _
                   ByVal nShowCmd As Long) As Long
Private Const SW_HIDE As Long = 0
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWMINIMIZED As Long = 2
Private Sub Command1_Click()
   ShellExecute Me.hwnd, "open", "C:\Users\Public\Test1.dwg", vbNullString, "C:", SW_SHOWNORMAL
End Sub

   Dim bcad As AcadApplication
   Dim I As Integer
   On Error Resume Next
Retry:   'In case Bricscad is closing down
   Set bcad = GetObject("", "BricscadApp.AcadApplication")
   If Err = -2147023179 Then
       I = I + 1
       Err.Clear
       If I > 1000 Then Exit Function
       GoTo Retry
   Set bcad = CreateObject("BricscadApp.AcadApplication")
   End If
   bcad.Visible = True