批量打印.docx
- 文档编号:3942354
- 上传时间:2022-11-26
- 格式:DOCX
- 页数:7
- 大小:53.55KB
批量打印.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
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 批量 打印
![提示](https://static.bdocx.com/images/bang_tan.gif)