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

CADVBA中一个模型空间不同图样的批量打印（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编辑器（工具→宏→VisualBasic编辑器），插入一个模块，将下面的过程代码复制进去第四步，修改参数第五步，运行过程参数说明参数式说明备注'本过程用于同一个模型内，多张图纸一键布局的应用。'要求：多张图纸的最大轮廓必须为同一大小，并且必须等行、等列排放。'变量表：'TZQDyi、TZZDer记录精确取点的值'TZxx、TZy、TZx大列循环（X方向）、行循环、小列循环（X方向）'TZxxjs大列的图纸个数'TZxjs小列的图纸个数'XBJjs布局个数'Mzx(0To2)、Mys(0To2)数组，记录选择的范围。'Mxuanze选择集对象'PDif选择的对象个数'newlayout布局对象'BJzx(0To1)、BJys(0To1)数组，记录窗选布局的范围'-----------------------------------------------------------------Subpiliangbuju()'批量布局DimTZQDyiAsVariantDimTZZDerAsVariantTZQDyi=ThisDrawing.Utility.GetPoint(,"左下")'精确取左下点TZZDer=ThisDrawing.Utility.GetPoint(,"右上")'精确取右上点ZoomAll'将所有图形显示DimTZxxAsIntegerDimTZxxjsAsIntegerDimTZxjsAsIntegerDimXBJjsAsIntegerXBJjs=0'布局名称计数TZxxjs=0'大列计数'获取正确打印纸名称DimBZiioAsStringDimBZnlaAsAcadLayoutDimlayoutsAsAcadLayoutsSetlayouts=ThisDrawing.layoutsForEachBZnlaInlayoutsIfBZnla.Name="Layout1"ThenBZiio=BZnla.CanonicalMediaNameEndIfNextForTZxx=0To2TZxjs=0DimTZyAsIntegerForTZy=0To3DimTZxAsIntegerTZx=0'单列X方向计数DoThisDrawing.ActiveSpace=acModelSpace'返回模型空间'指定图纸位置DimMzx(0To2)AsDoubleDimMys(0To2)AsDoubleMzx(0)=TZQDyi(0)1200*TZx1200*TZxxjs:Mzx(1)=TZQDyi(1)-800*TZy:Mzx(2)=0Mys(0)=TZZDer(0)1200*TZx1200*TZxxjs:Mys(1)=TZZDer(1)-800*TZy:Mys(2)=0DimMxuanzeAsAcadSelectionSetDimPDifAsIntegerSetMxuanze=ThisDrawing.SelectionSets.Add("XZ")'增加选择集Mxuanze.SelectacSelectionSetWindow,Mzx,Mys'窗选模式下选择集的范围PDif=Mxuanze.Count'输出选择集内部的对象数目IfPDif<>0ThenDimnewlayoutAsAcadLayoutSetnewlayout=ThisDrawing.layouts.Add("XBJ"&XBJjs)'增加新的布局ThisDrawing.ActiveLayout=newlayout'新增布局为活动布局newlayout.ConfigName="DWF6ePLOT.PC3"'新增布局的打印机newlayout.CanonicalMediaName=BZiio'新增布局的纸张'窗选模式下新增布局的范围DimBJzx(0To1)AsDoubleDimBJys(0To1)AsDoubleBJzx(0)=5321*TZx21*TZxxjs:BJzx(1)=10315*TZyBJys(0)=7421*TZx21*TZxxjs:BJys(1)=11715*TZynewlayout.SetWindowToPlotBJzx,BJys'指定窗选模式下新增布局的范围newlayout.PlotType=acWindow'指定新增布局为窗选模式newlayout.CenterPlot=True'指定新增布局居中newlayout.StandardScale=acScaleToFit'指定新增布局铺满纸张newlayout.PlotRotation=ac90degrees'指定新增布局横向打印newlayout.StyleSheet="acad.ctb"'指定新增布局打印样式XBJjs=XBJjs1EndIfMxuanze.Delete'删除选择集对象TZx=TZx1'记录单列最大的图纸数IfTZx>TZxjsThenTZxjs=TZxEndIfLoopUntilPDif=0NextTZxxjs=TZxjsTZxxjsNextEndSubTZQDyi、TZZDer不需要设置TZxx需要修改TZy需要修改Mxuanze、PDif不需要设置newlayout不需要设置ForTZxx=0To2中的“2”根据自己在模型空间所建立的大列数修改。3大列为2，4大列为3依次类推。ForTZy=0To3中的“3”指的是行数，有几行就写几。Mzx(0)=TZQDyi(0)1200*TZx1200*TZxxjs:Mzx(1)=TZQDyi(1)-800*TZy:Mzx(2)=0Mys(0)=TZZDer(0)1200*TZx1200*TZxxjs:Mys(1)=TZZDer(1)-800*TZy:Mys(2)=0中的“1200”为小列间距，直接测量出来；“800”为行间距，直接测量出来。BJzx(0)=5321*TZx21*TZxxjs:BJzx(1)=10315*TZyBJys(0)=7421*TZx21*TZxxjs:BJys(1)=11715*TZy中的“53”“103”“74”“117”为布局里第一张图纸的左下和右上坐标值，可在 标准 excel标准偏差excel标准偏差函数exl标准差函数国标检验抽样标准表免费下载红头文件格式标准下载 布局测得。“21”“15”为布局里列距和行距，计算可得。过程开始时，cad必须模型活动。精确取点，必须用鼠标在模型空间里获取。必须显示所有图纸，否则后面程序无法执行。新建标准布局“layout1”先返回模型空间选择集建立，如果过程在此失败，重新运行时修改“XZ”。新布局建立；新布局进行给定属性值时，必须有先后顺序，否则过程不认。如果过程在此失败，重新运行时删除新建的布局。将选择集删除，避免影响循环