CAD VBA中一个模型空间不同图样的批量打印(VBA程序)
CAD VBA中一个模型空间不同图样的批量打印（VBA程序）
说明：
1、本VBA程序在CAD2008/2009运行成功；电脑系统64位。
2、本程序仅对略有VBA基础知识同志共同学习、共勉；还请编程高手对不妥之处给予指正。谢谢大家！
3、本VBA程序用于解决如下问题：如下图所示，当一个Model有12张图形是如何使用VBA代码实现一键打印或发布。
一般情况下，VBA有三种解决思路：
a）在每个图形上进行矩形框标识，然后用VBA代码识别矩形框进行批量打印。
b）使用VBA代码进行批量布局，然后使用CAD的发布功能进行批量打印。
c）使用VBA代码进行图样位置识别，然后进行批量打印。
    4、本文仅对第二种和第三种方法进行程序演示。
b）使用VBA代码进行批量布局，然后使用CAD的发布功能进行批量打印。
      应用步骤：
      第一步，将图形等列、等行排放
      第二步，新建一个标题为“layout1”布局， “页面布局管理器”的参数修改为自己想要的参数
      第三步，打开VBA编辑器（工具→宏→Visual Basic编辑器），插入一个模块，将下面的过程代码复制进去
描写心情的四字词语      第四步，修改参数
      第五步，运行

过程
参数说明
参数式说明
备注
'本过程用于同一个模型内，多张图纸一键布局的应用。
'要求：多张图纸的最大轮廓必须为同一大小，并且必须等行、等列排放。
'变量表：
'TZQDyi、TZZDer记录精确取点的值
捷信现金贷款'TZxx、TZy 、TZx大列循环（X方向）、行循环、小列循环（X方向）
'TZxxjs大列的图纸个数
'TZxjs小列的图纸个数
'XBJjs布局个数
'Mzx(0 To 2)、Mys(0 To 2)数组，记录选择的范围。
'Mxuanze选择集对象
'PDif选择的对象个数
'newlayout布局对象
'BJzx(0 To 1)、BJys(0 To 1)数组，记录窗选布局的范围
'-----------------------------------------------------------------
Sub piliangbuju()  '批量布局
Dim TZQDyi As Variant
Dim TZZDer As Variant
TZQDyi = ThisDrawing.Utility.GetPoint(, "左下") '精确取左下点
TZZDer = ThisDrawing.Utility.GetPoint(, "右上") '精确取右上点
ZoomAll '将所有图形显示
Dim TZxx As Integer
Dim TZxxjs As Integer
Dim TZxjs As Integer
Dim XBJjs As Integer
XBJjs = 0 '布局名称计数
TZxxjs = 0 '大列计数
'获取正确打印纸名称
Dim BZiio As String
Dim BZnla As AcadLayout
Dim layouts As AcadLayouts
Set layouts = ThisDrawing.layouts
    For Each BZnla In layouts
    If BZnla.Name = "Layout1" Then
    BZiio = BZnla.CanonicalMediaName
    End If
    Next
   
For TZxx = 0 To 2
TZxjs = 0
Dim TZy As Integer
For TZy = 0 To 3
Dim TZx As Integer
TZx = 0 '单列X方向计数
Do
夏普60寸电视机ThisDrawing.ActiveSpace = acModelSpace '返回模型空间
'指定图纸位置
Dim Mzx(0 To 2) As Double
Dim Mys(0 To 2) As Double
Mzx(0) = TZQDyi(0) + 1200 * TZx + 1200 * TZxxjs: Mzx(1) = TZQDyi(1) - 800 * TZy: Mzx(2) = 0
Mys(0) = TZZDer(0) + 1200 * TZx + 1200 * TZxxjs: Mys(1) = TZZDer(1) - 800 * TZy: Mys(2) = 0
Dim Mxuanze As AcadSelectionSet
Dim PDif As Integer
Set Mxuanze = ThisDrawing.SelectionSets.Add("XZ") '增加选择集
Mxuanze.Select acSelectionSetWindow, Mzx, Mys '窗选模式下选择集的范围
PDif = Mxuanze.Count '输出选择集内部的对象数目
If PDif <> 0 Then
    Dim newlayout As AcadLayout
    Set newlayout = ThisDrawing.layouts.Add("XBJ" & XBJjs) '增加新的布局
    ThisDrawing.ActiveLayout = newlayout '新增布局为活动布局
    newlayout.ConfigName = "DWF6 ePLOT.PC3" '新增布局的打印机
    newlayout.CanonicalMediaName = BZiio '新增布局的纸张
    '窗选模式下新增布局的范围
    Dim BJzx(0 To 1) As Double
    Dim BJys(0 To 1) As Double
    BJzx(0) = 53 + 21 * TZx + 21 * TZxxjs: BJzx(1) = 103 + 15 * TZy
    BJys(0) = 74 + 21 * TZx + 21 * TZxxjs: BJys(1) = 117 + 15 * TZy
    newlayout.SetWindowToPlot BJzx, BJys '指定窗选模式下新增布局的范围
    newlayout.PlotType = acWindow '指定新增布局为窗选模式
    newlayout.CenterPlot = True '指定新增布局居中
    newlayout.StandardScale = acScaleToFit '指定新增布局铺满纸张
    newlayout.PlotRotation = ac90degrees '指定新增布局横向打印
    newlayout.StyleSheet = "b" '指定新增布局打印样式
XBJjs = XBJjs + 1
End If
Mxuanze.Delete '删除选择集对象
TZx = TZx + 1
'记录单列最大的图纸数
If TZx > TZxjs Then
TZxjs = TZx
End If
Loop Until PDif = 0
Next
TZxxjs = TZxjs + TZxxjs
Next
End Sub
TZQDyi、TZZDer不需要设置
TZxx需要修改
工商营业执照办理TZy 需要修改
Mxuanze 、PDif不需要设置
newlayout不需要设置
For TZxx = 0 To 2中的“2”根据自己在模型空间所建立的大列数修改。3大列为2，4大列为3依次类推。
For TZy = 0 To 3中的“3”指的是行数，有几行就写几。
Mzx(0) = TZQDyi(0) + 1200 * TZx + 1200 * TZxxjs: Mzx(1) = TZQDyi(1) - 800 * TZy: Mzx(2) = 0
Mys(0) = TZZDer(0) + 1200 * TZx + 1200 * TZxxjs: Mys(1) = TZZDer(1) - 800 * TZy: Mys(2) = 0中的“1200”为小列间距，直接测量出来；“800”为行间距，直接测量出来。
BJzx(0) = 53 + 21 * TZx + 21 * TZxxjs: BJzx(1) = 103 + 15 * TZy
BJys(0) = 74 + 21 * TZx + 21 * TZxxjs: BJys(1) = 117 + 15 * TZy
中的“53”“103”“74”“117”为布局里第一张图纸的左下和右上坐标值，可在标准布局测得。“21”“15”为布局里列距和行距，计算可得。
他不是独行侠>广西龙脊梯田过程开始时，cad必须模型活动。
精确取点，必须用鼠标在模型空间里获取。
必须显示所有图纸，否则后面程序无法执行。
新建标准布局“layout1”
先返回模型空间
选择集建立，如果过程在此失败，重新运行时修改“XZ”。
新布局建立；新布局进行给定属性值时，必须有先后顺序，否则过程不认。如果过程在此失败，重新运行时删除新建的布局。
将选择集删除，避免影响循环

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。