CADVBA批量打印程序

1、CAD/VBA批量打印打印图纸，不折不扣的体力活。最多一次打了600多张图，打印机都因体力不支中途休息了几次，如果不是用程序批打，估计我也得累个半死。下面贴出打印过程的代码，加个for循环就可以批打了。简单说明一下打印函数PrinterName-打印机名称Styles-样式表名称MediaName-纸张大小Copies-打印份数AutoMedia-自动纸张开关AutoRotate-自动旋转,纵向/横向AutoClose-打印完毕关闭文档AutoFrame-自动判断图框，主要针对图框为块的情形打印过程并没有提供全部的AUTOCAD打印选项，因为我一般用不到，比如打印偏移、打印到文件我从来不用的，

2、如果需要可以添加进去。程序会根据指定块名查找图框，也可以根据块的纵横比例自动判断是否为图框，然后按块打印，一张图纸中允许有多个图框；对于编组(Group)形式的图框，指定编组名即可如果没有找到任何图框块或编组时，按图纸范围打印另外，打印时会先预览，然后由用户选择是否打印，避免打错。代码如下SubQuickPlot()CallPlotFunction(SHARPAR-M256,A3,1,True,True,False,True)EndSubSubPlot2PDF()CallPlotFunction(pdfFactoryPro,acad.ctb,1,True,True,False,True)End

3、SubSubPlotA4()CallPlotFunction(SHARPAR-M256,acad.ctb,A4,1,False,True,False,True)EndSub快速打印/批量打印PublicSubPlotFunction(PrinterNameAsString,StylesAsString,MediaNameAsString,CopiesAsInteger,_AutoMediaAsBoolean,AutoRotateAsBoolean,AutoCloseAsBoolean,AutoFrameAsBoolean)OnErrorResumeNextDimptMinAsVariant,p

4、tMaxAsVariantDimEntAsAcadEntityDimPlotCountAsIntegerSetobjDoc=ThisDrawing.Application.ActiveDocumentSetobjLayout=objDoc.Layouts.Item(Model)SetobjPlot=objDoc.PlotThisDrawing.Application.ZoomExtents设置打印机IfNotTrim(PrinterName)=ThenobjLayout.ConfigName=PrinterNameElseExitSubEndIf设置打印样式表IfNotTrim(Styles)

5、=ThenobjLayout.StyleSheet=StylesElseobjLayout.StyleSheet=acad.ctbEndIf设置图纸尺寸IfAutoMediaThenobjLayout.CanonicalMediaName=A3ElseIfNotTrim(MediaName)=ThenobjLayout.CanonicalMediaName=MediaNameElseobjLayout.CanonicalMediaName=A3EndIfEndIf设置图纸单位objLayout.PaperUnits=acMillimetersobjLayout.PaperUnits=acInc

6、hes设置默认图纸打印方向objLayout.PlotRotation=ac0degrees纵向objLayout.PlotRotation=ac180degreesobjLayout.PlotRotation=ac90degrees横向objLayout.PlotRotation=ac270degrees设置图纸打印比例objLayout.StandardScale=acScaleToFitobjLayout.UseStandardScale=True使用标准打印比例objLayout.UseStandardScale=False使用自定义打印比例设置自定义打印比例objLayout.Set

7、CustomScaletxtNumerator.Value,txtDenominator.Value设置图纸是否居中打印objLayout.CenterPlot=True打印时使用图形文件中的线宽objLayout.PlotWithLineweights=True设置是否应用打印样式objLayout.PlotWithPlotStyles=True打印时隐藏图纸空间对象objLayout.PlotHidden=False设置图纸打印份数IfCopies=1ThenobjPlot.NumberOfCopies=CInt(Copies)ElseobjPlot.NumberOfCopies=1End

8、If将打印错误报告切换为静默错误模式，以便不间断地执行打印任务objPlot.QuietErrorMode=True重新生成当前图形objDoc.RegenacAllViewports设置前台打印，使打印任务按打印顺序依次发送到打印机objDoc.SetVariableBACKGROUNDPLOT,0PlotCount=0打印计数ForEachEntInobjDoc.ModelSpaceIfTypeOfEntIsAcadBlockReferenceThenIfIsFrame(Ent,AutoFrame)=TrueAndobjDoc.Blocks(Ent.Name).count0ThenEnt.

9、GetBoundingBoxptMin,ptMaxDebug.PrintEnt.Name&-&objDoc.Blocks(Ent.Name).count将三维点转化为二维点坐标ReDimPreserveptMin(0To1)ReDimPreserveptMax(0To1)设置打印窗口ThisDrawing.ActiveLayout.SetWindowToPlotptMin,ptMaxobjLayout.PlotType=acWindowIfAbs(ptMax(0)-ptMin(0)0ThenDebug.PrintFrmGrp.Name&Items:&FrmGrp.count&group得到图框

10、边界点坐标FrmGrp.Item(0).GetBoundingBoxptMin,ptMaxFori=1ToFrmGrp.count-1FrmGrp.Item(i).GetBoundingBoxTptMin,TptMaxReDimPreserveTptMin(0To1)ReDimPreserveTptMax(0To1)Forj=0To1IfTptMin(j)ptMax(j)ThenptMax(j)=TptMax(j)EndIfNextji=i+1Next将三维点转化为二维点坐标ReDimPreserveptMin(0To1)ReDimPreserveptMax(0To1)设置打印窗口ThisDr

11、awing.ActiveLayout.SetWindowToPlotptMin,ptMaxobjLayout.PlotType=acWindowIfAbs(ptMax(0)-ptMin(0)0ThenptMax=ThisDrawing.GetVariable(EXTMAX)ptMin=ThisDrawing.GetVariable(EXTMIN)图形范围内无实体则退出IfptMax(0)=ptMin(0)OrptMax(1)=ptMin(1)ThenExitSubEndIf设置范围打印objLayout.PlotType=acExtents对纵向的图纸设置IfAbs(ptMax(0)-ptMi

12、n(0)Abs(ptMax(1)-ptMin(1)ThenIfAutoMediaThenobjLayout.CanonicalMediaName=A4IfAutoRotateThenobjLayout.PlotRotation=ac0degreesEndIf完全预览并提示打印objPlot.DisplayPlotPreviewacFullPreviewUserSel=MsgBox(是否打印预览？”&Chr(13)&Chr(13)&打印到：&objLayout.ConfigName&_大小：&objLayout.CanonicalMediaName&方式：acExtents(&objLayout

13、.PlotType&)&_Chr(13)&Chr(13)&选择取消退出程序！,vbYesNoCancel,打印选项)IfUserSel=vbYesThenobjPlot.PlotToDeviceobjLayout.ConfigNameElseIfUserSel=vbCancelThenExitSubEndIfEndIf关闭文档False为不保存修改IfAutoCloseThenobjDoc.CloseFalse,ThisDrawing.NameEndSubPublicFunctionIsFrame(entobjAsObject,AutoModeAsBoolean)AsBoolean判断是否为图

14、框OnErrorResumeNextIsFrame=FalseDimiAsIntegerDimFrmNameListAsVariantFrmNameList=blkFrame,A1,A2,A3,A4,PC_PAPER_DIC图框块、编组名列表FrmNameList=Split(FrmNameList,)Fori=0ToUBound(FrmNameList)Ifentobj.Name=FrmNameList(i)ThenIsFrame=TrueExitForEndIfNext块名不符时由大小比例判断是否为图框(可能会误判,不过几率不高)IfIsFrame=FalseAndAutoModeAnde

15、ntobj.ObjectName=AcDbBlockReferenceThenentobj.GetBoundingBoxptMin,ptMaxDebug.PrintptMin(0)&-&ptMax(O)IfAbs(ptMax-ptMin(1)/(ptMax(0)-ptMin(0)-1.414)0.01OrAbs(ptMax-ptMin(1)/(ptMax(O)-ptMin(0)-0.707)0.01ThenIsFrame=TrueEndIfEndIfEndFunctionFunctionSNA11x17()DimobjPSAsAcadPlotConfigurationSetobjPS=This

16、Drawing.PlotConfigurations.Add(“SNA-AZTU-11x17”,False)objPS.ConfigName=“SERVER2SAVIN4035PCL6”objPS.CanonicalMediaName=“Tabloid”objPS.CenterPlot=TrueobjPS.PaperUnits=acInchesobjPS.PlotHidden=FalseobjPS.PlotRotation=ac90degreesobjPS.PlotType=acExtentsobjPS.PlotViewportBorders=FalseobjPS.PlotViewportsF

17、irst=TrueobjPS.PlotWithLineweights=TrueobjPS.PlotWithPlotStyles=TrueobjPS.ScaleLineweights=FalseobjPS.ShowPlotStyles=FalseobjPS.StandardScale=acScaleToFitobjPS.StyleSheet=“SNA-11X17.ctb”objPS.UseStandardScale=TruePublicSubSetupAndPlot(ByRefPlotterAsString,CTBAsString,SIZEAsString,PSCALEAsString,ROTA

18、sString)DimLayoutAsAcadLayoutOnErrorGoToErr_ControlSetLayout=ThisDrawing.ActiveLayoutLayout.RefreshPlotDeviceInfoLayout.ConfigName=PlotterCALLPLOTTERLayout.PLOTTYPE=acExtentsLayout.PlotRotation=ROTCALLROTATIONLayout.StyleSheet=CTBCALLCTBFILELayout.PlotWithPlotStyles=TrueLayout.CanonicalMediaName=SIZ

19、ECALLSIZELayout.PaperUnits=acInchesLayout.StandardScale=PSCALECALLPSCALELayout.ShowPlotStyles=FalseThisDrawing.Plot.NumberOfCopies=1Layout.CenterPlot=TrueLayout.ScaleLineweights=FalseLayout.RefreshPlotDeviceInfoThisDrawing.RegenacAllViewportsZoomExtentsSetLayout=NothingThisDrawing.SaveExit_Here:Exit

20、SubErr_Control:SelectCaseErr.NumberCase-2145320861MsgBoxUnabletoSaveDrawing-&Err.DescriptionCase-2145386493MsgBoxDrawingissetupforNamedPlotStyles.&(Chr(13)&(Chr(13)&RunCONVERTPSTYLEScommand,vbCritical,ChangePlotStyleCaseElseMsgBoxUnknownError&Err.NumberEndSelectEndSubSubPcsMM()DimpCAsAcadPlotConfigu

21、rationDimPCsAsAcadPlotConfigurationsDimoLayoutAsAcadLayoutDimoLayoutsAsAcadLayoutsDimPlotOrig(1)AsDoubleDimOrigSetoLayouts=ThisDrawing.LayoutsSetPCs=ThisDrawing.PlotConfigurationsSetoLayout=ThisDrawing.PaperSpace.LayoutPlotOrig(0)=18.542:PlotOrig(1)=12.192SetpC=PCs.Add(22x34final,False)WithpC.PlotTy

22、pe=acExtents.CanonicalMediaName=User1639.CenterPlot=True.ConfigName=DESIGNSERVERHPDJ.PlotOrigin=PlotOrig.PlotRotation=ac180degrees.StandardScale=ac1_1EndWithPcTyppCoLayout.CopyFrompCPlotOrig(0)=19.01:PlotOrig(1)=12.68SetpC=PCs.Add(22x34draft,False)WithpC.PlotType=acLayout.CanonicalMediaName=User1639

23、.ConfigName=DESIGNSERVERHPDRAFT.PaperUnits=acMillimeters.PlotOrigin=PlotOrig.PlotRotation=ac180degrees.StandardScale=ac1_1EndWithPcTyppCoLayout.CopyFrompCPlotOrig(0)=1.31:PlotOrig(1)=4.48SetpC=PCs.Add(11x17half,False)WithpC.PlotType=acExtents.CenterPlot=True.ConfigName=designserverKONICA.PaperUnits=

24、acMillimeters.PlotOrigin=PlotOrig.PlotRotation=ac270degrees.StandardScale=ac1_2.CanonicalMediaName=User288.CanonicalMediaName=TabloidEndWithPcTyppCModelSpaceSetoLayout=ThisDrawing.ModelSpace.LayoutSetpC=PCs.Add(22x34-model,True)WithpC.ConfigName=DESIGNSERVERHPDJ.StandardScale=ac1_1.CanonicalMediaName=User1639.PlotType=acExtents.PlotRotation=ac180degreesEndWithPCAddspCSetpC=PC