CAD VBA批量打印
下面是根据本人制作的“图纸边框”动态块编写的cad批打程序
动态块下载链接：
https://www.wendangku.net/doc/c96901039.html,/share/link?shareid=1524357130&uk=1007346156
'批量打印
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