[编程交流] 打开组合框中的dwg文件

 
''Go to Tools->References, add Reference to Microsoft Scripting Runtime
''Go to Tools->Options->General->Error Trapping frame check  "Break on Unhandled Errors" button
Option Explicit
'' your folder path here:
Const frameFolder As String = "C:\Drawing Frame" '<--backslash at the end
Function FileExist(dwgName As String) As Boolean
   Dim txt As String
   Dim fs As Object
   Dim fl As Object
   
   Set fs = CreateObject("Scripting.FileSystemObject")
    On Error GoTo Err_Control
   Set fl = fs.Getfile(dwgName)
   If Not fl Is Nothing Then
   FileExist = True
   Exit Function
   End If
Err_Control:
   FileExist = False
End Function
Private Sub CommandButton1_Click()
Dim frameDwg As String
frameDwg = ComboBox1.Text
Dim dwgName As String
dwgName = frameFolder & frameDwg & ".dwg" '<--build a full path of drawing here
MsgBox FileExist(dwgName)
End Sub
Private Sub CommandButton2_Click()
Dim myBlock As AcadBlockReference
Dim blockInsert(0 To 2) As Double
Dim frameDwg As String
frameDwg = ComboBox1.Text '<-- get selected item
Dim dwgName As String
dwgName = frameFolder & frameDwg & ".dwg" '<--build a full path of drawing here
If Not FileExist(dwgName) Then
MsgBox "File:" & vbCr & dwgName & " does not exists"
Exit Sub
End If
MsgBox dwgName
blockInsert(0) = -18
blockInsert(1) = -6
blockInsert(2) = 0
Set myBlock = ThisDrawing.PaperSpace.InsertBlock(blockInsert, dwgName, 1, 1, 1, 0)
ComboBox1.ListIndex = -1 '<--refresh combo
End Sub

 
With ThisDrawing
.ActiveLayout = .Layouts("Layout1")
End With