批量打印Word格式文档下载.docx
- 文档编号:16849291
- 上传时间:2022-11-26
- 格式:DOCX
- 页数:7
- 大小:53.55KB
批量打印Word格式文档下载.docx
《批量打印Word格式文档下载.docx》由会员分享,可在线阅读,更多相关《批量打印Word格式文档下载.docx(7页珍藏版)》请在冰豆网上搜索。
对于编组(Group)形式的图框,指定编组名即可
如果没有找到任何图框块或编组时,按图纸范围打印
另外,打印时会先预览,然后由用户选择是否打印,避免打错。
[代码如下]-By:
忽又一天
SubQuickPlot()
CallPlotFunction("
SHARPAR-M256"
"
"
A3"
1,True,True,False,True)
EndSub
SubPlot2PDF()
pdfFactoryPro"
acad.ctb"
SubPlotA4()
A4"
1,False,True,False,True)
'
快速打印/批量打印
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)="
objLayout.StyleSheet=Styles
objLayout.StyleSheet="
设置图纸尺寸
IfAutoMediaThen
objLayout.CanonicalMediaName="
IfNotTrim(MediaName)="
objLayout.CanonicalMediaName=MediaName
设置图纸单位
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)
objPlot.NumberOfCopies=1
将打印错误报告切换为静默错误模式,以便不间断地执行打印任务
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))<
Abs(ptMax
(1)-ptMin
(1))Then
IfAutoMediaThenobjLayout.CanonicalMediaName="
IfAutoRotateThenobjLayout.PlotRotation=ac0degrees
完全预览并提示打印
objPlot.DisplayPlotPreviewacFullPreview
UserSel=MsgBox("
是否打印预览?
Chr(13)&
打印到:
objLayout.ConfigName&
_
大小:
objLayout.CanonicalMediaName&
方式:
acWindow("
objLayout.PlotType&
)"
Chr(13)&
选择[取消]退出程序!
vbYesNoCancel,"
打印选项"
IfUserSel=vbYesThen
objPlot.PlotToDeviceobjLayout.ConfigName
PlotCount=PlotCount+1
ElseIfUserSel=vbCancelThen
ExitFor
NextEnt
图框为编组(Group)对象时
DimFrmGrpAsAcadGroup
DimTptMin,TptMaxAsVariant
按编组名称查找图框编组对象
ForEachFrmGrpInThisDrawing.Groups
IfIsFrame(FrmGrp,False)AndFrmGrp.count>
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)Then
ptMin(j)=TptMin(j)
IfTptMax(j)>
ptMax(j)Then
ptMax(j)=TptMax(j)
Nextj
i=i+1
Next
IfUserSel=vbYesThen
ElseIfUserSel=vbCancelThen
NextFrmGrp
没有找到图框时按范围打印
IfPlotCount=0AndobjDoc.ModelSpace.count>
ptMax=ThisDrawing.GetVariable("
EXTMAX"
ptMin=ThisDrawing.GetVariable("
EXTMIN"
图形范围内无实体则退出
IfptMax(0)=ptMin(0)OrptMax
(1)=ptMin
(1)Then
设置范围打印
objLayout.PlotType=acExtents
对纵向的图纸设置
acExtents("
关闭文档False为不保存修改
IfAutoCloseThenobjDoc.CloseFalse,ThisDrawing.Name
PublicFunctionIsFrame(entobjAsObject,AutoModeAsBoolean)AsBoolean
判断是否为图框
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
块名不符时由大小比例判断是否为图框(可能会误判,不过几率不高)
IfIsFrame=FalseAndAutoModeAndentobj.ObjectName="
AcDbBlockReference"
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
EndFunction
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 批量 打印