想写一个批量插入文件的vba程序，但没有头绪？？
想写一个批量插入文件的程序，能调用所需用到的电子地图，以简化工作（不需要一幅一幅的进行插入），但不知道从哪里开始着手，请教高人指点！！象插入图块一样写程序就行
Re：象插入图块一样写程序就行
能告诉我如何调用插入图块的方法吗？另外，怎样才能实现批量插入的功能呢？插入外部图形的例子
Sub InsBlk()' 插入外部图形的例子
Dim blockRefObj As AcadBlockReference
Dim blkName As String
blkName = "D:\1.dwg" '此处为图形的路径名称
insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, blkName, 1#, 1#, 1#, 0)
ZoomAll
End Sub
而批量插入则要看你是怎样选择图形的
Re：插入外部图形的例子
比较经常用到的是以下两种模式：一是将文件夹中的所有文件插入，另一是选定数个文件一次性插入，请问上述两者都能实现吗？多DWG文件选择及选择整个目录下的DWG文件进行插入的例子如内
首先工程中必须使用“CommonDialog-在VBA中使用的公用对话框模块”，见以下链接：http://www.mjtd.com/mcdown/list.asp?id=83
开始工程前应输入CommonDialog.cls文件及modConstants.bas文件。
程序如下：
'通过选定多个图形文件插入到图形中的过程
Sub IntBlkBySelectDwg()
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 = getFileBySelect("选择图形：", "dwg", "AutoCAD图形文件(*.dwg)|*.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
'通过选定整个目录中的图形文件插入到图形中的过程
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
'选定多个文件的函数，使用了CommonDialog类
Public Function getFileBySelect(DialogTitle, DefaultExt, Filter) As Variant
Dim dlg As CommonDialog
Dim Files As Variant
Dim i As Integer
Set dlg = New CommonDialog
With dlg
.DialogTitle = DialogTitle
.DefaultExt = DefaultExt
.Filter = Filter
.Flags = OFN_EXPLORER Or OFN_HIDEREADONLY Or OFN_ALLOWMULTISELECT
If .ShowOpen Then
getFileBySelect = .ParseFileNames
End If
End With
End Function
'返回指定目录下指定名称所有文件的函数
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
万分感谢斑竹的鼎力帮助！！
THANK YOU VERY MUCH!!在您的帮助下，已经达到了批量插入的功能，希望以后能多向您请教。 找了几天终于找到这个了。mcca太伟大了。我搜索“批量插入光栅图”或“批量插入图片”，没想到这个关键词是“批量插入文件” '通过选定多个图形文件插入到图形中的过程
试了一下，只能选择一个文件，cad2004版本 这次试验成功，但是在cad2004之外的版本都不行了。难道那个commonDialog类有问题么？
页:
[1]