CADVBA批量打印程序

1、CAD/VBA批量打印打印圖紙，不折不扣的體力活。最多一次打了600多張圖，打印機(jī)都因體力不支中途休息了幾次，如果不是用程序批打，估計(jì)我也得累個(gè)半死。下面貼出打印過(guò)程的代碼，加個(gè)for循環(huán)就可以批打了。簡(jiǎn)單說(shuō)明一下打印函數(shù)PrinterName-打印機(jī)名稱(chēng)Styles-樣式表名稱(chēng)MediaName-紙張大小Copies-打印份數(shù)AutoMedia-自動(dòng)紙張開(kāi)關(guān)AutoRotate-自動(dòng)旋轉(zhuǎn),縱向/橫向AutoClose-打印完畢關(guān)閉文檔AutoFrame-自動(dòng)判斷圖框，主要針對(duì)圖框?yàn)閴K的情形打印過(guò)程并沒(méi)有提供全部的AUTOCAD打印選項(xiàng)，因?yàn)槲乙话阌貌坏?，比如打印偏移、打印到文件我從?lái)不用的，

2、如果需要可以添加進(jìn)去。程序會(huì)根據(jù)指定塊名查找圖框，也可以根據(jù)塊的縱橫比例自動(dòng)判斷是否為圖框，然后按塊打印，一張圖紙中允許有多個(gè)圖框；對(duì)于編組(Group)形式的圖框，指定編組名即可如果沒(méi)有找到任何圖框塊或編組時(shí)，按圖紙范圍打印另外，打印時(shí)會(huì)先預(yù)覽，然后由用戶(hù)選擇是否打印，避免打錯(cuò)。代碼如下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設(shè)置打印機(jī)IfNotTrim(PrinterName)=ThenobjLayout.ConfigName=PrinterNameElseExitSubEndIf設(shè)置打印樣式表IfNotTrim(Styles)

5、=ThenobjLayout.StyleSheet=StylesElseobjLayout.StyleSheet=acad.ctbEndIf設(shè)置圖紙尺寸IfAutoMediaThenobjLayout.CanonicalMediaName=A3ElseIfNotTrim(MediaName)=ThenobjLayout.CanonicalMediaName=MediaNameElseobjLayout.CanonicalMediaName=A3EndIfEndIf設(shè)置圖紙單位objLayout.PaperUnits=acMillimetersobjLayout.PaperUnits=acInc

6、hes設(shè)置默認(rèn)圖紙打印方向objLayout.PlotRotation=ac0degrees縱向objLayout.PlotRotation=ac180degreesobjLayout.PlotRotation=ac90degrees橫向objLayout.PlotRotation=ac270degrees設(shè)置圖紙打印比例objLayout.StandardScale=acScaleToFitobjLayout.UseStandardScale=True使用標(biāo)準(zhǔn)打印比例objLayout.UseStandardScale=False使用自定義打印比例設(shè)置自定義打印比例objLayout.Set

7、CustomScaletxtNumerator.Value,txtDenominator.Value設(shè)置圖紙是否居中打印objLayout.CenterPlot=True打印時(shí)使用圖形文件中的線寬objLayout.PlotWithLineweights=True設(shè)置是否應(yīng)用打印樣式objLayout.PlotWithPlotStyles=True打印時(shí)隱藏圖紙空間對(duì)象objLayout.PlotHidden=False設(shè)置圖紙打印份數(shù)IfCopies=1ThenobjPlot.NumberOfCopies=CInt(Copies)ElseobjPlot.NumberOfCopies=1End

8、If將打印錯(cuò)誤報(bào)告切換為靜默錯(cuò)誤模式，以便不間斷地執(zhí)行打印任務(wù)objPlot.QuietErrorMode=True重新生成當(dāng)前圖形objDoc.RegenacAllViewports設(shè)置前臺(tái)打印，使打印任務(wù)按打印順序依次發(fā)送到打印機(jī)objDoc.SetVariableBACKGROUNDPLOT,0PlotCount=0打印計(jì)數(shù)ForEachEntInobjDoc.ModelSpaceIfTypeOfEntIsAcadBlockReferenceThenIfIsFrame(Ent,AutoFrame)=TrueAndobjDoc.Blocks(Ent.Name).count0ThenEnt.

9、GetBoundingBoxptMin,ptMaxDebug.PrintEnt.Name&-&objDoc.Blocks(Ent.Name).count將三維點(diǎn)轉(zhuǎn)化為二維點(diǎn)坐標(biāo)ReDimPreserveptMin(0To1)ReDimPreserveptMax(0To1)設(shè)置打印窗口ThisDrawing.ActiveLayout.SetWindowToPlotptMin,ptMaxobjLayout.PlotType=acWindowIfAbs(ptMax(0)-ptMin(0)0ThenDebug.PrintFrmGrp.Name&Items:&FrmGrp.count&group得到圖框

10、邊界點(diǎn)坐標(biāo)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將三維點(diǎn)轉(zhuǎn)化為二維點(diǎn)坐標(biāo)ReDimPreserveptMin(0To1)ReDimPreserveptMax(0To1)設(shè)置打印窗口ThisDr

11、awing.ActiveLayout.SetWindowToPlotptMin,ptMaxobjLayout.PlotType=acWindowIfAbs(ptMax(0)-ptMin(0)0ThenptMax=ThisDrawing.GetVariable(EXTMAX)ptMin=ThisDrawing.GetVariable(EXTMIN)圖形范圍內(nèi)無(wú)實(shí)體則退出IfptMax(0)=ptMin(0)OrptMax(1)=ptMin(1)ThenExitSubEndIf設(shè)置范圍打印objLayout.PlotType=acExtents對(duì)縱向的圖紙?jiān)O(shè)置IfAbs(ptMax(0)-ptMi

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

13、.PlotType&)&_Chr(13)&Chr(13)&選擇取消退出程序！,vbYesNoCancel,打印選項(xiàng))IfUserSel=vbYesThenobjPlot.PlotToDeviceobjLayout.ConfigNameElseIfUserSel=vbCancelThenExitSubEndIfEndIf關(guān)閉文檔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塊名不符時(shí)由大小比例判斷是否為圖框(可能會(huì)誤判,不過(guò)幾率不高)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