CAD VBA中一个模型空间不同图样的批量打印（VBA程序）(2)

过程 '本过程用于同一个模型内，多张图纸一键打印的应用。 '要求：多张图纸的最大轮廓必须为同一大小，并且必须等行、等列排放。 '变量表： 'TZQDyi、TZZDer记录精确取点的值 'TZxx、TZy 、TZx大列循环（X方向）、行循环、小列循环（X方向） 'TZxxjs大列的图纸个数 'TZxjs小列的图纸个数 'Mzx(0 To 2)、Mys(0 To 2)数组，记录选择的范围。 'Mxuanze选择集对象 'newplot打印对象 'PDif选择的对象个数 '----------------------------------------------------------------- Sub piliangdaying() '批量布局 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 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 = \ BZiio = BZnla.CanonicalMediaName End If 参数说明 参数式说明 备注 TZQDyi、TZZDer不需要设置 过程运行时必须在模型空间 精确取点，必须用鼠标在模型空间里获取。 必须显示所有图纸，否则后面程序无法执行。 Next For TZxx = 0 To 2 TZxjs = 0 Dim TZy As Integer For TZy = 0 To 3 Dim TZx As Integer TZxx需要设置 TZy需要设置 TZx = 0 '单列X方向计数 Do '指定图纸位置 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(\增加选择集 Mxuanze.Select acSelectionSetWindow, Mzx, Mys '窗选模式下选择集的范围 PDif = Mxuanze.Count '输出选择集内部的对象数目 If PDif <> 0 Then Dim newlayout As AcadLayout Set newlayout = ThisDrawing.ModelSpace.Layout '增加模型布局 newlayout.ConfigName = \模型布局的打印机 newlayout.CanonicalMediaName = BZiio '模型布局的纸张 '窗选模式下模型布局的范围 newlayout.SetWindowToPlot Mzx, Mys '指定窗选模式下模型布局的范围 newlayout.PlotType = acWindow '指定模型布局为窗选模式 newlayout.CenterPlot = True '指定模型布局居中 newlayout.StandardScale = acScaleToFit '指定模型布局铺满纸张 newlayout.PlotRotation = ac90degrees '指定模型布局横向打印 newlayout.StyleSheet = \指定模型布局打印样式 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”为行间距，直接测建立在模型空间中的量出来。 布局，用于打印参数的 获取 打印参数 如果想打印到PDF文件，请更改configname属性值。 Dim newplot As AcadPlot Set newplot = ThisDrawing.Plot newplot.PlotToDevice 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 建立新的打印对象，执行打印任务 将选择集删除，避免影响循环