打印图纸，不折不扣的体力活。

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

下面贴出打印过程的代码，加个for循环就可以批打了。

简单说明一下打印函数PrinterName - 打印机名称Styles - 样式表名称MediaName - 纸张大小Copies - 打印份数AutoMedia - 自动纸张开关AutoRotate - 自动旋转,纵向/横向AutoClose - 打印完毕关闭文档AutoFrame - 自动判断图框，主要针对图框为块的情形打印过程并没有提供全部的AUTO CAD打印选项，因为我一般用不到，比如"打印偏移"、"打印到文件"我从来不用的，如果需要可以添加进去。

程序会根据指定块名查找图框，也可以根据块的纵横比例自动判断是否为图框，然后按块打印，一张图纸中允许有多个图框；对于编组(Group)形式的图框，指定编组名即可如果没有找到任何图框块或编组时，按图纸范围打印另外，打印时会先预览，然后由用户选择是否打印，避免打错。

[代码如下] - By:忽又一天/suddenday/Sub QuickPlot()Call PlotFunction("SHARP AR-M256", "", "A3", 1, True, True, False, True)End SubSub Plot2PDF()Call PlotFunction("pdfFactory Pro", "acad.ctb", "", 1, True, True, False, True)End SubSub PlotA4()Call PlotFunction("SHARP AR-M256", "acad.ctb", "A4", 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 NextDim ptMin As Variant, ptMax As VariantDim Ent As AcadEntityDim PlotCount As IntegerSet objDoc = ThisDrawing.Application.ActiveDocumentSet objLayout = youts.Item("Model")Set objPlot = objDoc.PlotThisDrawing.Application.ZoomExtents' 设置打印机If Not Trim(PrinterName) = ""ThenobjLayout.ConfigName = PrinterNameElseExit SubEnd If' 设置打印样式表If Not Trim(Styles) = ""ThenobjLayout.StyleSheet = StylesElseobjLayout.StyleSheet = "acad.ctb"End If' 设置图纸尺寸If AutoMedia ThenobjLayout.CanonicalMediaName = "A3"ElseIf Not Trim(MediaName) = ""ThenobjLayout.CanonicalMediaName = MediaNameElseobjLayout.CanonicalMediaName = "A3"End IfEnd If' 设置图纸单位objLayout.PaperUnits = acMillimeters'objLayout.PaperUnits = acInches' 设置默认图纸打印方向'objLayout.PlotRotation = ac0degrees '纵向'objLayout.PlotRotation = ac180degreesobjLayout.PlotRotation = ac90degrees '横向'objLayout.PlotRotation = ac270degrees' 设置图纸打印比例objLayout.StandardScale = acScaleToFiteStandardScale = True'使用标准打印比例'eStandardScale = False '使用自定义打印比例' 设置自定义打印比例'objLayout.SetCustomScale txtNumerator.Value, txtDenominator.Value' 设置图纸是否居中打印objLayout.CenterPlot = True' 打印时使用图形文件中的线宽objLayout.PlotWithLineweights = True' 设置是否应用打印样式objLayout.PlotWithPlotStyles = True' 打印时隐藏图纸空间对象objLayout.PlotHidden = False' 设置图纸打印份数If Copies >= 1 ThenobjPlot.NumberOfCopies = CInt(Copies)ElseobjPlot.NumberOfCopies = 1End If' 将打印错误报告切换为静默错误模式，以便不间断地执行打印任务objPlot.QuietErrorMode = True' 重新生成当前图形objDoc.Regen acAllViewports' 设置前台打印，使打印任务按打印顺序依次发送到打印机objDoc.SetVariable "BACKGROUNDPLOT", 0PlotCount = 0 '打印计数For Each Ent In objDoc.ModelSpaceIf TypeOf Ent Is AcadBlockReference ThenIf IsFrame(Ent, AutoFrame) = True And objDoc.Blocks().count > 0 Then Ent.GetBoundingBox ptMin, ptMaxDebug.Print & "--" & objDoc.Blocks().count' 将三维点转化为二维点坐标ReDim Preserve ptMin(0 To 1)ReDim Preserve ptMax(0 To 1)' 设置打印窗口ThisDrawing.ActiveLayout.SetWindowToPlot ptMin, ptMaxobjLayout.PlotType = acWindowIf Abs(ptMax(0) - ptMin(0)) < Abs(ptMax(1) - ptMin(1)) ThenIf AutoMedia Then objLayout.CanonicalMediaName = "A4"If AutoRotate Then objLayout.PlotRotation = ac0degreesEnd If' 完全预览并提示打印objPlot.DisplayPlotPreview acFullPreviewUserSel = MsgBox("是否打印预览？" & Chr(13) & Chr(13) & "打印到：" & objLayout.ConfigName & _" 大小：" & objLayout.CanonicalMediaName & " 方式：acWindow(" & objLayout.PlotType & ") " & _Chr(13) & Chr(13) & "选择[取消]退出程序！", vbYesNoCancel, "打印选项") If UserSel = vbYes ThenobjPlot.PlotToDevice objLayout.ConfigNamePlotCount = PlotCount + 1ElseIf UserSel = vbCancel ThenExit ForEnd IfEnd IfEnd IfNext Ent' 图框为编组(Group)对象时Dim FrmGrp As AcadGroupDim TptMin, TptMax As Variant' 按编组名称查找图框编组对象For Each FrmGrp In ThisDrawing.GroupsIf IsFrame(FrmGrp, False) And FrmGrp.count > 0 ThenDebug.Print & " [Items]:" & FrmGrp.count & "----group"' 得到图框边界点坐标FrmGrp.Item(0).GetBoundingBox ptMin, ptMaxFor i = 1 To FrmGrp.count - 1FrmGrp.Item(i).GetBoundingBox TptMin, TptMaxReDim Preserve TptMin(0 To 1)ReDim Preserve TptMax(0 To 1)For j = 0 To 1If TptMin(j) < ptMin(j) ThenptMin(j) = TptMin(j)If TptMax(j) > ptMax(j) ThenptMax(j) = TptMax(j)End IfNext ji = i + 1Next' 将三维点转化为二维点坐标ReDim Preserve ptMin(0 To 1)ReDim Preserve ptMax(0 To 1)' 设置打印窗口ThisDrawing.ActiveLayout.SetWindowToPlot ptMin, ptMaxobjLayout.PlotType = acWindowIf Abs(ptMax(0) - ptMin(0)) < Abs(ptMax(1) - ptMin(1)) ThenIf AutoMedia Then objLayout.CanonicalMediaName = "A4"If AutoRotate Then objLayout.PlotRotation = ac0degreesEnd If' 完全预览并提示打印objPlot.DisplayPlotPreview acFullPreviewUserSel = MsgBox("是否打印预览？" & Chr(13) & Chr(13) & "打印到：" & objLayout.ConfigName & _" 大小：" & objLayout.CanonicalMediaName & " 方式：acWindow(" & objLayout.PlotType & ") " & _Chr(13) & Chr(13) & "选择[取消]退出程序！", vbYesNoCancel, "打印选项")If UserSel = vbYes ThenPlotCount = PlotCount + 1objPlot.PlotToDevice objLayout.ConfigNameElseIf UserSel = vbCancel ThenExit ForEnd IfEnd IfNext FrmGrp' 没有找到图框时按范围打印If PlotCount = 0 And objDoc.ModelSpace.count > 0 ThenptMax = ThisDrawing.GetVariable("EXTMAX")ptMin = ThisDrawing.GetVariable("EXTMIN")' 图形范围内无实体则退出If ptMax(0) = ptMin(0) Or ptMax(1) = ptMin(1) ThenExit Sub' 设置范围打印objLayout.PlotType = acExtents' 对纵向的图纸设置If Abs(ptMax(0) - ptMin(0)) < Abs(ptMax(1) - ptMin(1)) ThenIf AutoMedia Then objLayout.CanonicalMediaName = "A4"If AutoRotate Then objLayout.PlotRotation = ac0degreesEnd If' 完全预览并提示打印objPlot.DisplayPlotPreview acFullPreviewUserSel = MsgBox("是否打印预览？" & Chr(13) & Chr(13) & "打印到：" & objLayout.ConfigName & _" 大小：" & objLayout.CanonicalMediaName & " 方式：acExtents(" & objLayout.PlotType & ") " & _Chr(13) & Chr(13) & "选择[取消]退出程序！", vbYesNoCancel, "打印选项")If UserSel = vbYes ThenobjPlot.PlotToDevice objLayout.ConfigNameElseIf UserSel = vbCancel ThenExit SubEnd IfEnd If' 关闭文档False 为不保存修改If AutoClose Then objDoc.Close False, End SubPublic Function IsFrame(entobj As Object, AutoMode As Boolean) As Boolean '判断是否为图框On Error Resume NextIsFrame = FalseDim i As IntegerDim FrmNameList As VariantFrmNameList = "blkFrame,A1,A2,A3,A4,PC_PAPER_DIC"'图框块、编组名列表FrmNameList = Split(FrmNameList, ",")For i = 0 To UBound(FrmNameList)If = FrmNameList(i) ThenIsFrame = TrueExit ForEnd IfNext'块名不符时由大小比例判断是否为图框(可能会误判,不过几率不高)If IsFrame = False And AutoMode And entobj.ObjectName = "AcDbBlockReference"Then entobj.GetBoundingBox ptMin, ptMaxDebug.Print ptMin(0) & "--" & ptMax(0)If Abs((ptMax(1) - ptMin(1)) / (ptMax(0) - ptMin(0)) - 1.414) < 0.01 Or Abs((ptMax(1) - ptMin(1)) / (ptMax(0) - ptMin(0)) - 0.707) < 0.01 ThenIsFrame = TrueEnd IfEnd IfEnd Function。