78CAD VBA批量打印

'批量打印

Sub 打印()

On Error Resume Next

Dim ptMin, ptMax, 块属性, 打印尺寸 As Variant

Dim 对象 As AcadEntity

Dim 已打印张数, 是否打印, 比例前项 As Integer

Dim 文档 As AcadDocument

Dim 布局 As AcadLayout

Dim 出图布局 As AcadPlot

' Dim 是否打印 As Byte

Dim 打印份数 As String

' Dim 块属性 As Variant

Set 文档 = ThisDrawing.Application.ActiveDocument

Set 布局 = 文档.Layouts.Item("Model")

Set 出图布局 = 文档.Plot

'更新打印机、规范介质和打印样式表信息，以反映当前系统状态。

布局.RefreshPlotDeviceInfo

' 设置图纸单位

布局.PaperUnits = acMillimeters

' 设置图纸是否居中打印

布局.CenterPlot = True

' 打印时使用图形文件中的线宽

布局.PlotWithLineweights = True

'返回默认打印机配置名或指定默认打印机

块属性 = 布局.ConfigName '布局.ConfigName="打印机名称"

'获取指定打印设备的所有可用标准介质的名称(正使用打印机能打印的所有打印尺寸)

块属性 = 布局.GetCanonicalMediaNames()

'获取所有可用的打印设备名称。

块属性 = 布局.GetPlotDeviceNames()

已打印张数 = 0 '打印计数

For Each 对象 In 文档.ModelSpace

If TypeOf 对象 Is AcadBlockReference Then

If 对象.EffectiveName = "图纸边框" Then '

'从边框块属性中获取图纸规格大小，块属性(3).Value为图纸规格如“A3”，根据边框块定义不同，用不同的方法获取

块属性 = 对象.GetDynamicBlockProperties '获取动态块属性值

'判断打印机打印尺寸中是否包含图纸规格尺寸

For Each 打印尺寸 In 布局.GetCanonicalMediaNames()

If 打印尺寸 = 块属性(3).Value Then

布局.CanonicalMediaName = 块属性(3).Value '图纸规格如“A3”

Exit For

End If

Next 打印尺寸

If 布局.CanonicalMediaName = 块属性(3).Value Then '如果打印机能打印该图纸，则开始

'返回图元对象边框的最大和最小点，打印窗口范围

对象.GetBoundingBox ptMin, ptMax

' 将三维点转化为二维点坐标

ReDim Preserve ptMin(0 To 1)

ReDim Preserve ptMax(0 To 1)

'比较边框X、Y尺寸大小，X>Y为横向，否则为纵向打印

If ptMax(0) - ptMin(0) > ptMax(1) - ptMin(1) Then

布局.PlotRotation = ac0degrees '横向

比例前项 = Choose(CByte(Right(块属性(3).Value, 1)) + 1, 1179, 831, 584, 410, 297)

Else

布局.PlotRotation = ac90degrees '纵向

比例前项 = Choose(CByte(Right(块属性(3).Value, 1)) + 1, 831, 584, 410, 297, 200)

End If

布局.UseStandardScale = False '使用自定义打印比例

'

' ' 设置自定义打印比例

布局.SetCustomScale 比例前项, ptMax(0) - ptMin(0)

' 布局.UseStandardScale = ac10_1 '打印比例

If 打印份数 = "" Then 打印份数 = InputBox("请输入打印份数！", "录入询问", "1") '打印份数

If 打印份数 = "" Then 打印份数 = "1"

出图布局.NumberOfCopies = CInt(打印份数)

' 设置打印窗口

ThisDrawing.ActiveLayout.SetWindowToPlot ptMin, ptMax

' 重新生成当前图形

文档.Regen acAllViewports

' 完全预览并提示打印

出图布局.DisplayPlotPreview acPartialPreview 'acFullPreview

If 是否打印 = Empty Then 是否打印 = MsgBox("是否打印？ " & Chr(13) & Chr(13) & "打印到：" & 布局.ConfigName & _

" 大小：" & 布局.CanonicalMediaName & Chr(13) & Chr(13) & "选择[取消]退出程序！", vbYesNoCancel, "打印选项")

If 是否打印 = vbYes Then

出图布局.PlotToDevice 布局.ConfigName

已打印张数 = 已打印张数 + 1

ElseIf 是否打印 = vbCancel Then

Exit For

End If

Else

MsgBox "“" & 布局.ConfigName & "”不能打印“" & 块属性(3).Value & "”规格图纸！" _

& Chr(13) & "请选择合适打印机！", , "打印错误提醒！"

End If

End If

End If

Next 对象

MsgBox "共打印" & 已打印张数 & "张", , "打印张数统计"

End Sub