CAD-VBA批量打印程序

CAD/VBA批量打印打印圖紙，不折不扣的體力活。最多一次打了600多張圖，打印機都因“體力不支”中途休息了幾次，如果不是用程序批打，估計我也得累個半死。下面貼出打印過程的代碼，加個for循環(huán)就可以批打了。簡單說明一下打印函數(shù)PrinterName-打印機名稱Styles-樣式表名稱MediaName-紙張大小Copies-打印份數(shù)AutoMedia-自動紙張開關AutoRotate-自動旋轉，縱向/橫向AutoClose-打印完畢關閉文檔AutoFrame-自動判斷圖框，主要針對圖框為塊的情形打印過程并沒有提供全部的AUTOCAD打印選項，因為我一般用不到，比如"打印偏移"、”打印到文件“我從來不用的，如果需要可以添加進去。程序會根據(jù)指定塊名查找圖框，也可以根據(jù)塊的縱橫比例自動判斷是否為圖框，然后按塊打印，一張圖紙中允許有多個圖框；對于編組(Group)形式的圖框，指定編組名即可如果沒有找到任何圖框塊或編組時，按圖紙范圍打印另外，打印時會先預覽，然后由用戶選擇是否打印，避免打錯。［代碼如下］SubQuickPlot()CallPlotFunction("SHARPAR-M256","","A3",1,True,True,False,True)EndSubSubPlot2PDF()CallPlotFunction("pdfFactoryPro","acad.ctb","",1,True,True,False,True)EndSubSubPlotA4()CallPlotFunction("SHARPAR-M256","acad.ctb","A4",1,False,True,False,True)EndSub‘快速打印/批量打印PublicSubPlotFunction(PrinterNameAsString,StylesAsString,MediaNameAsString,CopiesAsInteger,_AutoMediaAsBoolean,AutoRotateAsBoolean,AutoCloseAsBoolean,AutoFrameAsBoolean)OnErrorResumeNextDimptMinAsVariant,ptMaxAsVariantDimEntAsAcadEntityDimPlotCountAsIntegerSetobjDoc=ThisDrawing.Application.ActiveDocumentSetobjLayout=objDoc.Layouts.Item("Model")word可自由復制編輯SetobjPlot=objDoc.PlotThisDrawing.Application.ZoomExtents,設置打印機IfNotTrim(PrinterName)=""ThenobjLayout.ConfigName=PrinterNameElseExitSubEndIf,設置打印樣式表IfNotTrim(Styles)=""ThenobjLayout.StyleSheet=StylesElseobjLayout.StyleSheet="acad.ctb"EndIf,設置圖紙尺寸IfAutoMediaThenobjLayout.CanonicalMediaName="A3"ElseIfNotTrim(MediaName)=""ThenobjLayout.CanonicalMediaName=MediaNameElseobjLayout.CanonicalMediaName="A3"EndIfEndIf,設置圖紙單位objLayout.PaperUnits=acMillimeters'objLayout.PaperUnits=acInches,設置默認圖紙打印方向'objLayout.PlotRotation=ac0degrees'縱向'objLayout.PlotRotation=ac180degreesobjLayout.PlotRotation=ac90degrees'橫向'objLayout.PlotRotation=ac270degrees,設置圖紙打印比例objLayout.StandardScale=acScaleToFitobjLayout.UseStandardScale=True'使用標準打印比例'objLayout.UseStandardScale=False使用自定義打印比例’設置自定義打印比例word可自由復制編輯'objLayout.SetCustomScaletxtNumerator.Value,txtDenominator.Value,設置圖紙是否居中打印objLayout.CenterPlot=True’打印時使用圖形文件中的線寬objLayout.PlotWithLineweights=True,設置是否應用打印樣式objLayout.PlotWithPlotStyles=True’打印時隱藏圖紙空間對象objLayout.PlotHidden=False,設置圖紙打印份數(shù)IfCopies>=1ThenobjPlot.NumberOfCopies=CInt(Copies)ElseobjPlot.NumberOfCopies=1EndIf,將打印錯誤報告切換為靜默錯誤模式，以便不間斷地執(zhí)行打印任務objPlot.QuietErrorMode=True,重新生成當前圖形objDoc.RegenacAllViewports,設置前臺打印，使打印任務按打印順序依次發(fā)送到打印機objDoc.SetVariable"BACKGROUNDPLOT",0PlotCount=0'打印計數(shù)ForEachEntInobjDoc.ModelSpaceIfTypeOfEntIsAcadBlockReferenceThenIfIsFrame(Ent,AutoFrame)=TrueAndobjDoc.Blocks(Ent.Name).count>0ThenEnt.GetBoundingBoxptMin,ptMaxDebug.PrintEnt.Name&"--"&objDoc.Blocks(Ent.Name).count'將三維點轉化為二維點坐標ReDimPreserveptMin(0To1)ReDimPreserveptMax(0To1),設置打印窗口ThisDrawing.ActiveLayout.SetWindowToPlotptMin,ptMaxword可自由復制編輯objLayout.PlotType=acWindowIfAbs(ptMax(0)-ptMin(0))<Abs(ptMax(1)-ptMin(1))ThenIfAutoMediaThenobjLayout.CanonicalMediaName="A4"IfAutoRotateThenobjLayout.PlotRotation=ac0degreesEndIf,完全預覽并提示打印objPlot.DisplayPlotPreviewacFullPreviewUserSel=MsgBox("是否打印預覽？"&Chr(13)&Chr(13)&"打印到："&objLayout.ConfigName&_"大?。?&objLayout.CanonicalMediaName&"方式：acWindow("&objLayout.PlotType&")"&_Chr(13)&Chr(13)&"選擇[取消]退出程序！'vbYesNoCancel,"打印選項")IfUserSel=vbYesThenobjPlot.PlotToDeviceobjLayout.ConfigNamePlotCount=PlotCount+1ElseIfUserSel=vbCancelThenExitForEndIfEndIfEndIfNextEnt,圖框為編組(Group)對象時DimFrmGrpAsAcadGroupDimTptMin,TptMaxAsVariant,按編組名稱查找圖框編組對象ForEachFrmGrpInThisDrawing.GroupsIfIsFrame(FrmGrp,False)AndFrmGrp.count>0ThenDebug.PrintFrmGrp.Name&"[Items]:"&FrmGrp.count&"----group",得到圖框邊界點坐標FrmGrp.Item(0).GetBoundingBoxptMin,ptMaxFori=1ToFrmGrp.count-1FrmGrp.Item(i).GetBoundingBoxTptMin,TptMaxReDimPreserveTptMin(0To1)ReDimPreserveTptMax(0To1)Forj=0To1IfTptMin(j)<ptMin(j)ThenptMin(j)=TptMin(j)EndIfIfTptMax(j)>ptMax(j)ThenptMax(j)=TptMax(j)word可自由復制編輯EndIfNextji=i+1Next,將三維點轉化為二維點坐標ReDimPreserveptMin(0To1)ReDimPreserveptMax(0To1),設置打印窗口ThisDrawing.ActiveLayout.SetWindowToPlotptMin,ptMaxobjLayout.PlotType=acWindowIfAbs(ptMax(0)-ptMin(0))<Abs(ptMax(1)-ptMin(1))ThenIfAutoMediaThenobjLayout.CanonicalMediaName="A4"IfAutoRotateThenobjLayout.PlotRotation=ac0degreesEndIf,完全預覽并提示打印objPlot.DisplayPlotPreviewacFullPreviewUserSel=MsgBox("是否打印預覽？"&Chr(13)&Chr(13)&"打印到："&objLayout.ConfigName&_"大?。?&objLayout.CanonicalMediaName&"方式：acWindow("&objLayout.PlotType&")"&_Chr(13)&Chr(13)&"選擇［取消］退出程序！",vbYesNoCancel,"打印選項")IfUserSel=vbYesThenPlotCount=PlotCount+1objPlot.PlotToDeviceobjLayout.ConfigNameElseIfUserSel=vbCancelThenExitForEndIfEndIfNextFrmGrp,沒有找到圖框時按范圍打印IfPlotCount=0AndobjDoc.ModelSpace.count>0ThenptMax=ThisDrawing.GetVariable("EXTMAX")ptMin=ThisDrawing.GetVariable("EXTMIN"),圖形范圍內無實體則退出IfptMax(0)=ptMin(0)OrptMax(1)=ptMin(1)ThenExitSubEndIf,設置范圍打印word可自由復制編輯objLayout.PlotType=acExtents,對縱向的圖紙設置IfAbs(ptMax(0)-ptMin(0))<Abs(ptMax(1)-ptMin(1))ThenIfAutoMediaThenobjLayout.CanonicalMediaName="A4"IfAutoRotateThenobjLayout.PlotRotation=ac0degreesEndIf,完全預覽并提示打印objPlot.DisplayPlotPreviewacFullPreviewUserSel=MsgBox("是否打印預覽？"&Chr(13)&Chr(13)&"打印到："&objLayout.ConfigName&_"大?。?&objLayout.CanonicalMediaName&"方式：acExtents("&objLayout.PlotType&")"&_Chr(13)&Chr(13)&"選擇［取消］退出程序！",vbYesNoCancel,"打印選項")IfUserSel=vbYesThenobjPlot.PlotToDeviceobjLayout.ConfigNameElseIfUserSel=vbCancelThenExitSubEndIfEndIf,關閉文檔False為不保存修改IfAutoCloseThenobjDoc.CloseFalse,ThisDrawing.NameEndSubPublicFunctionIsFrame(entobjAsObject,AutoModeAsBoolean)AsBoolean判斷是否為圖框OnErrorResumeNextIsFrame=FalseDimiAsIntegerDimFrmNameListAsVariantFrmNameList="blkFrame,A1,A2,A3,A4,PC_PAPER_DIC"'圖框塊、編組名列表FrmNameList=Split(FrmNameList,",")Fori=0ToUBound(FrmNameList)Ifentobj.Name=FrmNameList(i)ThenIsFrame=TrueExitForEndIfNext塊名不符時由大小比例判斷是否為圖框(可能會誤判，不過幾率不高)IfIsFrame=FalseAndAutoModeAndentobj.ObjectName="AcDbBlockReference"Thenentobj.GetBoundingBoxptMin,ptMaxword可自由復制編輯

Debug.PrintptMin(0)&"--"&ptMax(0)IfAbs((ptMax(1)-ptMin(1))/(ptMax(0)-ptMin(0))-1.414)<0.01OrAbs((ptMax(1)-ptMin(1))/(ptMax(0)-ptMin(0))-0.707)<0.01ThenIsFrame=TrueEndIfEndIfEndFunctionword可自由復制編輯FunctionSNA11x17()DimobjPSAsAcadPlotConfigurationSetobjPS=ThisDrawing.PlotConfigurations.Add(''SNA-AZTU-11x17〃,False)objPS.ConfigName=“\\SERVER2\SAVIN4035PCL6”objPS.CanonicalMediaName='Tabloid”objPS.CenterPlot=TrueobjPS.PaperUnits=acInchesobjPS.PlotHidden=FalseobjPS.PlotRotation=ac90degreesobjPS.PlotType=acExtentsobjPS.PlotViewportBorders=FalseobjPS.PlotViewportsFirst=TrueobjPS.PlotWithLineweights=TrueobjPS.PlotWithPlotStyles=TrueobjPS.ScaleLineweights=FalseobjPS.ShowPlotStyles=FalseobjPS.StandardScale=acScaleToFitobjPS.StyleSheet='SNA-11X17.ctb”objPS.UseStandardScale=TruePublicSubSetupAndPlot(ByRefPlotterAsString,CTBAsString,SIZEAsString,PSCALEAsString,ROTAsString)DimLayoutAsAcadLayoutOnErrorGoToErr_ControlSetLayout=ThisDrawing.ActiveLayoutLayout.RefreshPlotDeviceInfoLayout.ConfigName=Plotter'CALLPLOTTERLayout.PLOTTYPE=acExtentsLayout.PlotRotation=ROT'CALLROTATIONLayout.StyleSheet=CTB'CALLCTBFILELayout.PlotWithPlotStyles=TrueLayout.CanonicalMediaName=SIZE'CALLSIZELayout.PaperUnits=acInchesLayout.StandardScale=PSCALE'CALLPSCALELayout.ShowPlotStyles=FalseThisDrawing.Plot.NumberOfCopies=1Layout.CenterPlot=TrueLayout.ScaleLineweights=Falseword可自由復制編輯Layout.RefreshPlotDeviceInfoThisDrawing.RegenacAllViewportsZoomExtentsSetLayout=NothingThisDrawing.SaveExit_Here:ExitSubErr_Control:SelectCaseErr.NumberCase"-2145320861"MsgBox"UnabletoSaveDrawing-"&Err.DescriptionCase"-2145386493"MsgBox"DrawingissetupforNamedPlotStyles."&(Chr(13))&(Chr(13))&"RunCONVERTPSTYLEScommand",vbCritical,"ChangePlotStyle"CaseElseMsgBox"UnknownError"&Err.NumberEndSelectEndSubSubPcsMM()DimpCAsAcadPlotConfigurationDimPCsAsAcadPlotConfigurationsDimoLayoutAsAcadLayoutDimoLayoutsAsAcadLayoutsDimPlotOrig(1)AsDoubleDimOrigSetoLayouts=ThisDrawing.LayoutsSetPCs=ThisDrawing.PlotConfigurationsSetoLayout=ThisDrawing.PaperSpace.LayoutPlotOrig(0)=18.542:PlotOrig(1)=12.192SetpC=PCs.Add("22x34final",False)WithpC.PlotType=acExtents.CanonicalMediaName="User1639".CenterPlot=True.ConfigName="\\DESIGNSERVER\HPDJ"word可自由復制編輯.PlotOrigin=PlotOrig.PlotRotation=ac180degrees.StandardScale=ac1_1EndWithPcTyppCoLayout.CopyFrompCPlotOrig(0)=19.01:PlotOrig(1)=12.68SetpC=PCs.Add("22x34draft",False)WithpC.PlotType=acLayout.CanonicalMediaName="User1639”.ConfigName="\\DESIGNSERVER\HPDRAFT”.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="\\designserver\KONICA”.PaperUnits=acMillimeters.PlotOrigin=PlotOrig.PlotRotation=ac270degrees.StandardScale=ac1_2'.CanonicalMediaName="User288”.CanonicalMediaName="Tabloid"EndWithPcTyppCModelSpaceSetoLayout=ThisDrawing.ModelSpace.Layoutword可自由復制編輯SetpC=PCs.Add("22x34-model”,True)WithpC.ConfigName="\\DESIGNSERVER\HPDJ”.StandardS