CADVBA中一个模型空间不同图样的批量打印VBA程序

CAD VBACAD VBA 中一个模型空间不同图样的批量打印（中一个模型空间不同图样的批量打印（VBAVBA 程序）程序） 说明 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 布局个数 Mzx0 To 2、Mys0 To 2数组，记录选择的范围。 Mxuanze选择集对象 PDif 选择的对象个数 newlayout 布局对象 BJzx0 To 1、BJys0 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 参数说明参数式说明备注 TZQDyi、TZZDer不需 要设置 过程开始时，cad 必须 模型活动。 精确取点， 必须用鼠标 在模型空间里获取。 必须显示所有图纸， 否 则后面程序无法执行。 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 ThisDrawing.ActiveSpace acModelSpace 返回模型空间 指定图纸位置 Dim Mzx0 To 2 As Double Dim Mys0 To 2 As Double Mzx0 TZQDyi0 1200 * TZx 1200 * TZxxjs Mzx1 TZQDyi1 - 800 * TZy Mzx2 0 Mys0 TZZDer0 1200 * TZx 1200 * TZxxjs Mys1 TZZDer1 - 800 * TZy Mys2 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 BJzx0 To 1 As Double TZxx需要修改 TZy 需要修改 Mxuanze 、PDif不需 要设置 newlayout 不需要设 置 For TZxx 0 To 2中的“2”根据 自己在模型空间所建立的大列 数修改。3 大列为 2，4 大列为 3 依次类推。 For TZy 0 To 3中的“3”指的 是行数，有几行就写几。 Mzx0 TZQDyi0 1200 * TZx 1200*TZxxjsMzx1 TZQDyi1 - 800 * TZy Mzx2 0 Mys0 TZZDer0 1200 * TZx 1200*TZxxjsMys1 TZZDer1 - 800 * TZy Mys2 0 中的“1200”为小列间距， 直接测量出来； “800”为行间 距，直接测量出来。 新建标准布局 “layout1 ” 先返回模型空间 选择集建立， 如果过程 在此失败， 重新运行时 修改“XZ” 。 新布局建立； 新布局进 行给定属性值时， 必须 有先后顺序， 否则过程 不认。 如果过程在此失 败， 重新运行时删除新 建的布局。 Dim BJys0 To 1 As Double BJzx0 53 21 * TZx