通过选定整个目录中的图形文件插入到图形中的过程
Sub IntBlkByDirDwg()
On Error GoTo Err_Control
Dim BlkFile As Variant
Dim i As Integer
Dim InstPnt As Variant
Dim BlkRefObj As AcadBlockReference
Dim varCancel As Variant
BlkFile = GetDir("选择要插入图形所在的目录：", "*.dwg")
If IsArray(BlkFile) Then
ThisDrawing.Utility.Prompt vbCrLf & " 你选定了" & Str(UBound(BlkFile) + 1) & "个图形"
For i = 0 To UBound(BlkFile)
InstPnt = ThisDrawing.Utility.GetPoint(, vbCrLf & " 请选择图形 " & JustFileName(BlkFile(i)) & " 的插入点：")
Set BlkRefObj = ThisDrawing.ModelSpace.InsertBlock(InstPnt, _
BlkFile(i), 1#, 1#, 1#, 0#)
Next
End If
Exit_Here:
Exit Sub
Err_Control:
Select Case Err.Number
Case -2147352567
varCancel = ThisDrawing.GetVariable("LASTPROMPT")
If InStr(1, varCancel, "*Cancel*") <> 0 And InStr(1, varCancel, "*取消*") <> 0 Then
Err.Clear
Resume Exit_Here
Else
Err.Clear
Resume
End If
Case -2145320928
Err.Clear
Resume Exit_Here
Case Else
Resume Exit_Here
End Select
End Sub
'返回指定目录下指定名称所有文件的函数
Function GetFileListByPath(Path As String, FileName As String) As Variant
Dim s As String
Dim sFiles() As String
Dim i As Integer
s = Dir(Path & FileName)
If s <> "" Then
ReDim sFiles(i) As String
sFiles(i) = Path & s
i = 1
s = Dir()
While s <> ""
ReDim Preserve sFiles(i) As String
sFiles(i) = Path & s
i = i + 1
s = Dir()
Wend
GetFileListByPath = sFiles
End If
End Function
'选定目录的函数，使用了commonDialog类
Public Function GetDir(DialogTitle As String, FileName As String) As Variant
Dim dlg As CommonDialog
Dim Path As String
Dim FileList As Variant
Set dlg = New CommonDialog
dlg.DialogTitle = DialogTitle
If dlg.Browse Then
Path = dlg.Path
If Path <> "" Then
Path = Left$(Path, InStr(Path, vbNullChar) - 1)
If Right$(Path, 1) <> "\" Then Path = Path & "\"
FileList = GetFileListByPath(Path, "*.dwg")
GetDir = FileList
End If
End If
End Function
'由文件全路径名称返回文件的函数
Public Function JustFileName(FileName) As String
On Error Resume Next
Dim count As Integer
For count = Len(FileName) - 1 To 1 Step -1
If Mid(FileName, count, 1) = "\" Or Mid(FileName, count, 1) = "/" Then
JustFileName = Right(FileName, Len(FileName) - count)
Exit For
End If
Next
End Function
