CADVBA批量打印

打印图纸，不折不扣的体力活。最多一次打了600多张图，打印机都因\体力不支\中途休息了几次，如果不是用程序批打，估计我也得累个半死。

下面贴出打印过程的代码，加个for循环就可以批打了。简单说明一下打印函数 PrinterName - 打印机名称 Styles - 样式表名称 MediaName - 纸张大小 Copies - 打印份数 AutoMedia - 自动纸张开关 AutoRotate - 自动旋转,纵向/横向 AutoClose - 打印完毕关闭文档

AutoFrame - 自动判断图框，主要针对图框为块的情形

打印过程并没有提供全部的AUTO CAD打印选项，因为我一般用不到，比如\打印偏移\、\打印到文件\我从来不用的，如果需要可以添加进去。

程序会根据指定块名查找图框，也可以根据块的纵横比例自动判断是否为图框，然后按块打印，一张图纸中允许有多个图框；

对于编组(Group)形式的图框，指定编组名即可 如果没有找到任何图框块或编组时，按图纸范围打印

另外，打印时会先预览，然后由用户选择是否打印，避免打错。

[代码如下] - By:忽又一天 http://hi.http://www.wodefanwen.com//suddenday/ Sub QuickPlot()

Call PlotFunction(\, \, \, 1, True, True, False, True) End Sub

Sub Plot2PDF()

Call PlotFunction(\, \, \, 1, True, True, False, True) End Sub Sub PlotA4()

Call PlotFunction(\, \, \, 1, False, True, False, True) End Sub

'快速打印/批量打印

Public Sub PlotFunction(PrinterName As String, Styles As String, MediaName As String, Copies As Integer, _

AutoMedia As Boolean, AutoRotate As Boolean, AutoClose As Boolean, AutoFrame As Boolean)

On Error Resume Next

Dim ptMin As Variant, ptMax As Variant Dim Ent As AcadEntity Dim PlotCount As Integer

Set objDoc = ThisDrawing.Application.ActiveDocument Set objLayout = objDoc.Layouts.Item(\) Set objPlot = objDoc.Plot

ThisDrawing.Application.ZoomExtents

' 设置打印机

If Not Trim(PrinterName) = \ Then

objLayout.ConfigName = PrinterName Else Exit Sub End If

' 设置打印样式表

If Not Trim(Styles) = \ Then objLayout.StyleSheet = Styles Else

objLayout.StyleSheet = \ End If

' 设置图纸尺寸 If AutoMedia Then

objLayout.CanonicalMediaName = \ Else

If Not Trim(MediaName) = \ Then

objLayout.CanonicalMediaName = MediaName Else

objLayout.CanonicalMediaName = \ End If End If

' 设置图纸单位

objLayout.PaperUnits = acMillimeters 'objLayout.PaperUnits = acInches

' 设置默认图纸打印方向

'objLayout.PlotRotation = ac0degrees '纵向 'objLayout.PlotRotation = ac180degrees

objLayout.PlotRotation = ac90degrees '横向 'objLayout.PlotRotation = ac270degrees

' 设置图纸打印比例

objLayout.StandardScale = acScaleToFit

objLayout.UseStandardScale = True '使用标准打印比例

'objLayout.UseStandardScale = False '使用自定义打印比例

' 设置自定义打印比例

'objLayout.SetCustomScale txtNumerator.Value, txtDenominator.Value

' 设置图纸是否居中打印

objLayout.CenterPlot = True

' 打印时使用图形文件中的线宽

objLayout.PlotWithLineweights = True

' 设置是否应用打印样式

objLayout.PlotWithPlotStyles = True

' 打印时隐藏图纸空间对象 objLayout.PlotHidden = False

' 设置图纸打印份数 If Copies >= 1 Then

objPlot.NumberOfCopies = CInt(Copies) Else

objPlot.NumberOfCopies = 1 End If

' 将打印错误报告切换为静默错误模式，以便不间断地执行打印任务 objPlot.QuietErrorMode = True

' 重新生成当前图形

objDoc.Regen acAllViewports

' 设置前台打印，使打印任务按打印顺序依次发送到打印机 objDoc.SetVariable \, 0

PlotCount = 0 '打印计数

For Each Ent In objDoc.ModelSpace

If TypeOf Ent Is AcadBlockReference Then

If IsFrame(Ent, AutoFrame) = True And objDoc.Blocks(Ent.Name).count > 0 Then Ent.GetBoundingBox ptMin, ptMax

Debug.Print Ent.Name & \ & objDoc.Blocks(Ent.Name).count

' 将三维点转化为二维点坐标 ReDim Preserve ptMin(0 To 1) ReDim Preserve ptMax(0 To 1)

' 设置打印窗口

ThisDrawing.ActiveLayout.SetWindowToPlot ptMin, ptMax objLayout.PlotType = acWindow

If Abs(ptMax(0) - ptMin(0)) < Abs(ptMax(1) - ptMin(1)) Then If AutoMedia Then objLayout.CanonicalMediaName = \ If AutoRotate Then objLayout.PlotRotation = ac0degrees End If

' 完全预览并提示打印

objPlot.DisplayPlotPreview acFullPreview

UserSel = MsgBox(\是否打印预览？ \ & Chr(13) & Chr(13) & \打印到：\ & objLayout.ConfigName & _

\大小：\ & objLayout.CanonicalMediaName & \方式：acWindow(\ & objLayout.PlotType & \ & _

Chr(13) & Chr(13) & \选择[取消]退出程序！\, vbYesNoCancel, \打印选项\) If UserSel = vbYes Then

objPlot.PlotToDevice objLayout.ConfigName PlotCount = PlotCount + 1

ElseIf UserSel = vbCancel Then Exit For End If End If End If Next Ent

' 图框为编组(Group)对象时 Dim FrmGrp As AcadGroup Dim TptMin, TptMax As Variant

' 按编组名称查找图框编组对象

For Each FrmGrp In ThisDrawing.Groups

If IsFrame(FrmGrp, False) And FrmGrp.count > 0 Then

Debug.Print FrmGrp.Name & \[Items]:\ & FrmGrp.count & \

' 得到图框边界点坐标

FrmGrp.Item(0).GetBoundingBox ptMin, ptMax For i = 1 To FrmGrp.count - 1

FrmGrp.Item(i).GetBoundingBox TptMin, TptMax ReDim Preserve TptMin(0 To 1) ReDim Preserve TptMax(0 To 1) For j = 0 To 1

If TptMin(j) < ptMin(j) Then ptMin(j) = TptMin(j)

End If

If TptMax(j) > ptMax(j) Then ptMax(j) = TptMax(j) End If Next j i = i + 1 Next

' 将三维点转化为二维点坐标 ReDim Preserve ptMin(0 To 1) ReDim Preserve ptMax(0 To 1)

' 设置打印窗口

ThisDrawing.ActiveLayout.SetWindowToPlot ptMin, ptMax objLayout.PlotType = acWindow

If Abs(ptMax(0) - ptMin(0)) < Abs(ptMax(1) - ptMin(1)) Then If AutoMedia Then objLayout.CanonicalMediaName = \ If AutoRotate Then objLayout.PlotRotation = ac0degrees End If

' 完全预览并提示打印

objPlot.DisplayPlotPreview acFullPreview

UserSel = MsgBox(\是否打印预览？ \ & Chr(13) & Chr(13) & \打印到：\ & objLayout.ConfigName & _

\大小：\ & objLayout.CanonicalMediaName & \方式：acWindow(\ & objLayout.PlotType & \ & _

Chr(13) & Chr(13) & \选择[取消]退出程序！\, vbYesNoCancel, \打印选项\) If UserSel = vbYes Then PlotCount = PlotCount + 1

objPlot.PlotToDevice objLayout.ConfigName ElseIf UserSel = vbCancel Then Exit For End If End If

Next FrmGrp

' 没有找到图框时按范围打印

If PlotCount = 0 And objDoc.ModelSpace.count > 0 Then ptMax = ThisDrawing.GetVariable(\) ptMin = ThisDrawing.GetVariable(\)

' 图形范围内无实体则退出

If ptMax(0) = ptMin(0) Or ptMax(1) = ptMin(1) Then Exit Sub

百度搜索“77cn”或“免费范文网”即可找到本站免费阅读全部范文。收藏本站方便下次阅读，免费范文网，提供经典小说教育文库CADVBA批量打印在线全文阅读。