Set objPlot = objDoc.Plot ' 设置打印选项
Call SetPlotConfiguration ' 将打印设置应用到当前图形
objLayout.CopyFrom objPlotConfiguration '重新生成当前图形
objDoc.Regen acAllViewports
'对当前图形模型空间中的所有打印区域进行完全预览 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 '完全预览当前的区域
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
Public Function ReturnFolder(lngHwnd As Long) As String Dim Browser As BrowseInfo Dim lngFolder As Long Dim strPath As String Dim strTemp As String
With Browser
.hOwner = lngHwnd
.lpszTitle = \选择工作路径\
.pszDisplayName = String(MAX_PATH, 0) End With
'用空格填充字符串
strPath = String(MAX_PATH, 0) '调用API函数显示文件夹列表
lngFolder = SHBrowseForFolder(Browser)
'使用API函数获取返回的路径 If lngFolder Then
SHGetPathFromIDList lngFolder, strPath
strTemp = Left(strPath, InStr(strPath, vbNullChar) - 1)
If (Right(strTemp, 1) <> \ strTemp = strTemp & \ End If
ReturnFolder = strTemp End If End Function
Public Sub FindFile(ByRef files As Collection, strDir, strExt) '删除集合中所有的对象 Dim i As Integer
For i = 1 To files.count files.Remove 1 Next i
'查找dwg文件，并将其添加到集合中 Dim strFileName As String
If (Right(strDir, 1) <> \ strDir = strDir & \
End If
strFileName = Dir(strDir & \
Do While (strFileName <> \
If (UCase(Right(strFileName, 3)) = UCase(strExt)) Then files.Add strDir & strFileName End If
strFileName = Dir '返回下一个符合条件的文件 Loop End Sub
Public Function AddToList(objBox As ListBox, Names As Collection) As Boolean
Dim i As Integer
On Error GoTo Error_Control
objBox.Clear
'将集合中的对象添加到列表框中 For i = 1 To Names.count objBox.AddItem Names(i) Next i
Exit_Here:
AddToList = True Exit Function
Error_Control:
MsgBox \发生下面的错误：\.Number AddToList = False End Function
Private Function HasItem(objBox As ListBox, strFlies As String) As Boolean
'检查路径是否已经存在 HasItem = False
Dim i As Integer
If objBox.ListCount > 0 Then
For i = 0 To objBox.ListCount - 1
If StrComp(objBox.List(i), strFlies, vbTextCompare) = 0 Then HasItem = True Exit Function End If Next i
End If End Function
Private Function HasItem2(ByVal strPath As String) As Integer
'检查路径是否已经存在 HasItem2 = -1
Dim i As Integer
If cboPlotPath.ListCount > 0 Then
For i = 0 To cboPlotPath.ListCount - 1
If StrComp(cboPlotPath.List(i), strPath, vbTextCompare) = 0 Then HasItem2 = i Exit Function End If Next i End If End Function
'打开或激活文件
Private Sub OpenFile(fileName As String) Dim dwgFile As AcadDocument Dim strFile As String
For Each dwgFile In ThisDrawing.Application.Documents strFile = dwgFile.Path & \ '若第i个图形文件已经被打开，则将其激活 If strFile = fileName Then
'若dwgFile尚未激活，则将其激活 If dwgFile.Active = False Then
ThisDrawing.Application.ActiveDocument = dwgFile End If Exit Sub End If Next
'若第i个图形文件尚未被打开，则将其打开
ThisDrawing.Application.Documents.Open fileName
End Sub
' 显示AutoCAD中当前可用的打印机列表 Public Sub ListPlotDeviceNames() '取得当前布局对象
Set objLayout = ThisDrawing.ActiveLayout '取得当前打印机配置信息
objPlotConfiguration.ConfigName = objLayout.ConfigName '刷新这个工作任务当前的打印信息
objPlotConfiguration.RefreshPlotDeviceInfo '列出系统上所有有效的设备名称 Dim plotDevices As Variant
plotDevices = objPlotConfiguration.GetPlotDeviceNames '删除以前的打印机列表 cboPrintersName.Clear '显示打印机列表 Dim i As Integer
For i = 0 To UBound(plotDevices)
cboPrintersName.AddItem (plotDevices(i)) '设置默认的显示项目
If objPlotConfiguration.ConfigName = plotDevices(i) cboPrintersName.ListIndex = i Next i
'设置组合框初始选项 With cboPrintersName '使用下拉列表的形式
.Style = fmStyleDropDownList '设置默认的显示项目
If .ListIndex = -1 Then .ListIndex = 0 End With
End Sub
' 显示AutoCAD中当前可用的图纸尺寸 Public Sub ListPaperSize() '取得当前布局对象
Set objLayout = ThisDrawing.ActiveLayout
If cboPrintersName.Text = objLayout.ConfigName Then '取得当用图纸尺寸 objPlotConfiguration.CanonicalMediaName objLayout.CanonicalMediaName End If
'刷新打印设备信息
objPlotConfiguration.RefreshPlotDeviceInfo '列出所有介质的名称以及它们的本地版本
paperSizes = objPlotConfiguration.GetCanonicalMediaNames '删除以前的图纸尺寸列表 cboPaperSize.Clear '显示图纸尺寸列表 Dim i As Integer
For i = 0 To UBound(paperSizes)
Then =