批量打印.docx
《批量打印.docx》由会员分享，可在线阅读，更多相关《批量打印.docx（7页珍藏版）》请在冰豆网上搜索。
批量打印
打印图纸，不折不扣的体力活。
最多一次打了600多张图，打印机都因"体力不支"中途休息了几次，如果不是用程序批打，估计我也得累个半死。
下面贴出打印过程的代码，加个for循环就可以批打了。
简单说明一下打印函数
PrinterName-打印机名称
Styles-样式表名称
MediaName-纸张大小
Copies-打印份数
AutoMedia-自动纸张开关
AutoRotate-自动旋转,纵向/横向
AutoClose-打印完毕关闭文档
AutoFrame-自动判断图框，主要针对图框为块的情形
打印过程并没有提供全部的AUTOCAD打印选项，因为我一般用不到，比如"打印偏移"、"打印到文件"我从来不用的，如果需要可以添加进去。
程序会根据指定块名查找图框，也可以根据块的纵横比例自动判断是否为图框，然后按块打印，一张图纸中允许有多个图框；
对于编组（Group）形式的图框，指定编组名即可
如果没有找到任何图框块或编组时，按图纸范围打印
另外，打印时会先预览，然后由用户选择是否打印，避免打错。
[代码如下]-By:
忽又一天
SubQuickPlot（）
CallPlotFunction（"SHARPAR-M256","","A3",1,True,True,False,True）
EndSub
SubPlot2PDF（）
CallPlotFunction（"pdfFactoryPro","acad.ctb","",1,True,True,False,True）
EndSub
SubPlotA4（）
CallPlotFunction（"SHARPAR-M256","acad.ctb","A4",1,False,True,False,True）
EndSub
'快速打印/批量打印
PublicSubPlotFunction（PrinterNameAsString,StylesAsString,MediaNameAsString,CopiesAsInteger,_
AutoMediaAsBoolean,AutoRotateAsBoolean,AutoCloseAsBoolean,AutoFrameAsBoolean）
OnErrorResumeNext
DimptMinAsVariant,ptMaxAsVariant
DimEntAsAcadEntity
DimPlotCountAsInteger
SetobjDoc=ThisDrawing.Application.ActiveDocument
SetobjLayout=objDoc.Layouts.Item（"Model"）
SetobjPlot=objDoc.Plot
ThisDrawing.Application.ZoomExtents
'设置打印机
IfNotTrim（PrinterName）=""Then
objLayout.ConfigName=PrinterName
Else
ExitSub
EndIf
'设置打印样式表
IfNotTrim（Styles）=""Then
objLayout.StyleSheet=Styles
Else
objLayout.StyleSheet="acad.ctb"
EndIf
'设置图纸尺寸
IfAutoMediaThen
objLayout.CanonicalMediaName="A3"
Else
IfNotTrim（MediaName）=""Then
objLayout.CanonicalMediaName=MediaName
Else
objLayout.CanonicalMediaName="A3"
EndIf
EndIf
'设置图纸单位
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.SetCustomScaletxtNumerator.Value,txtDenominator.Value
'设置图纸是否居中打印
objLayout.CenterPlot=True
'打印时使用图形文件中的线宽
objLayout.PlotWithLineweights=True
'设置是否应用打印样式
objLayout.PlotWithPlotStyles=True
'打印时隐藏图纸空间对象
objLayout.PlotHidden=False
'设置图纸打印份数
IfCopies>=1Then
objPlot.NumberOfCopies=CInt（Copies）
Else
objPlot.NumberOfCopies=1
EndIf
'将打印错误报告切换为静默错误模式，以便不间断地执行打印任务
objPlot.QuietErrorMode=True
'重新生成当前图形
objDoc.RegenacAllViewports
'设置前台打印，使打印任务按打印顺序依次发送到打印机
objDoc.SetVariable"BACKGROUNDPLOT",0
PlotCount=0 '打印计数
ForEachEntInobjDoc.ModelSpace
IfTypeOfEntIsAcadBlockReferenceThen
IfIsFrame（Ent,AutoFrame）=TrueAndobjDoc.Blocks（Ent.Name）.count>0Then
Ent.GetBoundingBoxptMin,ptMax
Debug.PrintEnt.Name&"--"&objDoc.Blocks（Ent.Name）.count
'将三维点转化为二维点坐标
ReDimPreserveptMin（0To1）
ReDimPreserveptMax（0To1）
'设置打印窗口
ThisDrawing.ActiveLayout.SetWindowToPlotptMin,ptMax
objLayout.PlotType=acWindow
IfAbs（ptMax（0）-ptMin（0））（1）-ptMin
（1））Then
IfAutoMediaThenobjLayout.CanonicalMediaName="A4"
IfAutoRotateThenobjLayout.PlotRotation=ac0degrees
EndIf
'完全预览并提示打印
objPlot.DisplayPlotPreviewacFullPreview
UserSel=MsgBox（"是否打印预览？
"&Chr（13）&Chr（13）&"打印到：
"&objLayout.ConfigName&_
" 大小：
"&objLayout.CanonicalMediaName&" 方式：
acWindow（"&objLayout.PlotType&"）"&_
Chr（13）&Chr（13）&"选择[取消]退出程序！
",vbYesNoCancel,"打印选项"）
IfUserSel=vbYesThen
objPlot.PlotToDeviceobjLayout.ConfigName
PlotCount=PlotCount+1
ElseIfUserSel=vbCancelThen
ExitFor
EndIf
EndIf
EndIf
NextEnt
'图框为编组（Group）对象时
DimFrmGrpAsAcadGroup
DimTptMin,TptMaxAsVariant
'按编组名称查找图框编组对象
ForEachFrmGrpInThisDrawing.Groups
IfIsFrame（FrmGrp,False）AndFrmGrp.count>0Then
Debug.PrintFrmGrp.Name&" [Items]:
"&FrmGrp.count&"----group"
'得到图框边界点坐标
FrmGrp.Item（0）.GetBoundingBoxptMin,ptMax
Fori=1ToFrmGrp.count-1
FrmGrp.Item（i）.GetBoundingBoxTptMin,TptMax
ReDimPreserveTptMin（0To1）
ReDimPreserveTptMax（0To1）
Forj=0To1
IfTptMin（j） ptMin（j）=TptMin（j）
EndIf
IfTptMax（j）>ptMax（j）Then
ptMax（j）=TptMax（j）
EndIf
Nextj
i=i+1
Next
'将三维点转化为二维点坐标
ReDimPreserveptMin（0To1）
ReDimPreserveptMax（0To1）
'设置打印窗口
ThisDrawing.ActiveLayout.SetWindowToPlotptMin,ptMax
objLayout.PlotType=acWindow
IfAbs（ptMax（0）-ptMin（0））（1）-ptMin
（1））Then
IfAutoMediaThenobjLayout.CanonicalMediaName="A4"
IfAutoRotateThenobjLayout.PlotRotation=ac0degrees
EndIf
'完全预览并提示打印
objPlot.DisplayPlotPreviewacFullPreview
UserSel=MsgBox（"是否打印预览？
"&Chr（13）&Chr（13）&"打印到：
"&objLayout.ConfigName&_
" 大小：
"&objLayout.CanonicalMediaName&" 方式：
acWindow（"&objLayout.PlotType&"）"&_
Chr（13）&Chr（13）&"选择[取消]退出程序！
",vbYesNoCancel,"打印选项"）
IfUserSel=vbYesThen
PlotCount=PlotCount+1
objPlot.PlotToDeviceobjLayout.ConfigName
ElseIfUserSel=vbCancelThen
ExitFor
EndIf
EndIf
NextFrmGrp
'没有找到图框时按范围打印
IfPlotCount=0AndobjDoc.ModelSpace.count>0Then
ptMax=ThisDrawing.GetVariable（"EXTMAX"）
ptMin=ThisDrawing.GetVariable（"EXTMIN"）
'图形范围内无实体则退出
IfptMax（0）=ptMin（0）OrptMax
（1）=ptMin
（1）Then
ExitSub
EndIf
'设置范围打印
objLayout.PlotType=acExtents
'对纵向的图纸设置
IfAbs（ptMax（0）-ptMin（0））（1）-ptMin
（1））Then
IfAutoMediaThenobjLayout.CanonicalMediaName="A4"
IfAutoRotateThenobjLayout.PlotRotation=ac0degrees
EndIf
'完全预览并提示打印
objPlot.DisplayPlotPreviewacFullPreview
UserSel=MsgBox（"是否打印预览？
"&Chr（13）&Chr（13）&"打印到：
"&objLayout.ConfigName&_
" 大小：
"&objLayout.CanonicalMediaName&" 方式：
acExtents（"&objLayout.PlotType&"）"&_
Chr（13）&Chr（13）&"选择[取消]退出程序！
",vbYesNoCancel,"打印选项"）
IfUserSel=vbYesThen
objPlot.PlotToDeviceobjLayout.ConfigName
ElseIfUserSel=vbCancelThen
ExitSub
EndIf
EndIf
'关闭文档False为不保存修改
IfAutoCloseThenobjDoc.CloseFalse,ThisDrawing.Name
EndSub
PublicFunctionIsFrame（entobjAsObject,AutoModeAsBoolean）AsBoolean '判断是否为图框
OnErrorResumeNext
IsFrame=False
DimiAsInteger
DimFrmNameListAsVariant
FrmNameList="blkFrame,A1,A2,A3,A4,PC_PAPER_DIC" '图框块、编组名列表
FrmNameList=Split（FrmNameList,","）
Fori=0ToUBound（FrmNameList）
Ifentobj.Name=FrmNameList（i）Then
IsFrame=True
ExitFor
EndIf
Next
'块名不符时由大小比例判断是否为图框（可能会误判,不过几率不高）
IfIsFrame=FalseAndAutoModeAndentobj.ObjectName="AcDbBlockReference"Then
entobj.GetBoundingBoxptMin,ptMax
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.01Then
IsFrame=True
EndIf
EndIf
EndFunction
升级会员 