'对当前图形模型空间中的所有打印区域进行打印 Dim SSet As AcadSelectionSet '使用选择集获得对象集合
Call SelectByBlock(strBlockReferenceName, SSet)
'对选择集中每个对象进行打印或预览 For Each ent In SSet
'获得每个对象最小包围框的两个角点 ent.GetBoundingBox ptMin, ptMax '将三维点转化为二维点坐标
ReDim Preserve ptMin(0 To 1) ReDim Preserve ptMax(0 To 1) '设置打印窗口
objLayout.SetWindowToPlot ptMin, ptMax ' 打印当前的区域 '若选中“打印到文件”
If chkPlotToFile.Value Then
objPlot.PlotToFile cboPlotPath.Text & objDoc.name & \\
n = n + 1 Else
objPlot.PlotToDevice objLayout.ConfigName End If Next ent ' 删除选择集 SSet.Delete
' 恢复系统变量的值
objDoc.SetVariable \ '保存当前图形 'objDoc.Save
'关闭但不保存当前图形 '保证至少一个文件打开
If ThisDrawing.Application.Documents.count > 1 Then objDoc.Close False End If Next i
'显示对话框
frmBatchPlot.Show End Sub
Private Sub BatchPlotByLayer(strLayerName As String) On Error Resume Next
'如果列表框中未存在任何元素
If lstPlotFiles.ListCount = 0 Then
MsgBox \请先向列表框中添加文件！\ Exit Sub End If
'将控制权交给AutoCAD frmBatchPlot.Hide
' 对第i个图形的每一个打印区域进行打印 Dim ptMin As Variant, ptMax As Variant Dim ent As AcadEntity
Dim i As Integer, n As Integer
For i = 0 To lstPlotFiles.ListCount - 1 n = 1
'检查文件是否存在
If Len(Dir(lstPlotFiles.List(i))) = 0 Then
MsgBox \文件\不存在！\ End If
'打开或激活第i个图形文件
Call OpenFile(lstPlotFiles.List(i))
Set objDoc = ThisDrawing.Application.ActiveDocument '实现范围缩放
ThisDrawing.Application.ZoomExtents ' 确保当前布局是模型空间
Set objLayout = objDoc.Layouts.Item(\ Set objPlot = objDoc.Plot ' 设置打印选项
Call SetPlotConfiguration ' 将打印设置应用到当前图形
objLayout.CopyFrom objPlotConfiguration '重新生成当前图形
objDoc.Regen acAllViewports
' 确保AutoCAD在前台进行打印，这样后一次打印会在前一次打印完成之后才开始,避免出现错误
objDoc.SetVariable \
'对当前图形模型空间中的所有打印区域进行打印 Dim SSet As AcadSelectionSet '使用选择集获得对象集合
Call SelectByLayer(strLayerName, SSet)
'对选择集中每个对象进行打印或预览 For Each ent In SSet
'获得每个对象最小包围框的两个角点
ent.GetBoundingBox ptMin, ptMax '将三维点转化为二维点坐标
ReDim Preserve ptMin(0 To 1) ReDim Preserve ptMax(0 To 1) '设置打印窗口
objLayout.SetWindowToPlot ptMin, ptMax ' 打印当前的区域 '若选中“打印到文件”
If chkPlotToFile.Value Then
objPlot.PlotToFile cboPlotPath.Text & objDoc.name & \\
n = n + 1 Else
objPlot.PlotToDevice objLayout.ConfigName End If Next ent ' 删除选择集 SSet.Delete
' 恢复系统变量的值
objDoc.SetVariable \ '保存当前图形 'objDoc.Save
'关闭但不保存当前图形 '保证至少一个文件打开
If ThisDrawing.Application.Documents.count > 1 Then objDoc.Close False End If Next i
'显示对话框
frmBatchPlot.Show End Sub
Private Sub PreviewByBlock(strBlockReferenceName As String) On Error Resume Next '如果列表框中未存在任何元素
If lstPlotFiles.ListCount = 0 Then
MsgBox \请先向列表框中添加文件！\ Exit Sub End If
'将控制权交给AutoCAD frmBatchPlot.Hide
' 对第一个图形的第一个打印区域进行完全预览
Dim ptMin As Variant, ptMax As Variant Dim ent As AcadEntity
Dim i As Integer, n As Integer
For i = 0 To lstPlotFiles.ListCount - 1 n = 1
'检查文件是否存在
If Len(Dir(lstPlotFiles.List(i))) = 0 Then
MsgBox \文件\不存在！\ End If
'打开或激活第i个图形文件
Call OpenFile(lstPlotFiles.List(i))
Set objDoc = ThisDrawing.Application.ActiveDocument '实现范围缩放
ThisDrawing.Application.ZoomExtents ' 确保当前布局是模型空间
Set objLayout = objDoc.Layouts.Item(\ Set objPlot = objDoc.Plot ' 设置打印选项
Call SetPlotConfiguration ' 将打印设置应用到当前图形
objLayout.CopyFrom objPlotConfiguration '重新生成当前图形
objDoc.Regen acAllViewports
'对当前图形模型空间中的所有打印区域进行完全预览 Dim SSet As AcadSelectionSet '使用选择集获得对象集合
Call SelectByBlock(strBlockReferenceName, SSet) '对选择集中每个对象进行打印或预览 For Each ent In SSet
'获得每个对象最小包围框的两个角点 ent.GetBoundingBox ptMin, ptMax '将三维点转化为二维点坐标
ReDim Preserve ptMin(0 To 1) ReDim Preserve ptMax(0 To 1) '设置打印窗口
objLayout.SetWindowToPlot ptMin, ptMax '完全预览当前的区域
objPlot.DisplayPlotPreview acFullPreview n = n + 1 If n > 1 Then
'恢复原来的打印设置
objLayout.CopyFrom objOriginalPC '显示对话框
frmBatchPlot.Show Exit Sub End If Next ent ' 删除选择集 SSet.Delete Next i
'无打印区域时显示对话框
MsgBox \选定图形中无打印区域！\ '恢复原来的打印设置
objLayout.CopyFrom objOriginalPC '显示对话框
frmBatchPlot.Show
End Sub
Private Sub PreviewByLayer(strLayerName As String) On Error Resume Next '如果列表框中未存在任何元素
If lstPlotFiles.ListCount = 0 Then
MsgBox \请先向列表框中添加文件！\ Exit Sub End If
'将控制权交给AutoCAD frmBatchPlot.Hide
' 对第一个图形的第一个打印区域进行完全预览 Dim ptMin As Variant, ptMax As Variant Dim ent As AcadEntity
Dim i As Integer, n As Integer
For i = 0 To lstPlotFiles.ListCount - 1 n = 1
'检查文件是否存在
If Len(Dir(lstPlotFiles.List(i))) = 0 Then
MsgBox \文件\不存在！\ End If
'打开或激活第i个图形文件
Call OpenFile(lstPlotFiles.List(i))
Set objDoc = ThisDrawing.Application.ActiveDocument '实现范围缩放
ThisDrawing.Application.ZoomExtents ' 确保当前布局是模型空间
Set objLayout = objDoc.Layouts.Item(\