CADVBA批量打印
cad如何使用批量打印命令

cad如何使用批量打印命令
一般情况下打印CAD的图纸都是单张打印,那么在什么情况下使用批量打印的命令呢?下面是店铺带来关于cad如何使用批量打印命令的内容,希望可以让大家有所收获!
cad使用批量打印命令的方法
打开需要打印挡图纸
在下面输入 bp 回车(插件要先安装一下才可以用到这个命令)
如何安装cad插件海龙工具箱提高绘图效率
弹出批量打印对话框,对里面进行设置,选择这几个选项后,点从图中指定块或图层。
就会跳到cad界面,选择图框图块
选择好后,图块显示后面会出现这图块的名称,点选择要处理的图纸
选择好后,回车,返回到批量打印设置界面,选择亮显,看刚才选择的是否成功,选择的会出现打叉红框。
如果不对就重新选择
设置一下打印设置
选择修改
选择打印机
设置打印的纸张,打印区域,打印比例,纸张方向和打印样式,
点确定。
点关闭
这样这边就会显示刚才设置的内容
点确定,就会自动打印刚才选择图纸了,打印大量的图纸是不是很轻松了。
CAD批量打印与输出技巧

CAD批量打印与输出技巧CAD(计算机辅助设计)是一种广泛应用于工程设计领域的软件工具,它可以帮助工程师们更高效地进行各种设计任务。
在设计过程中,我们通常需要将设计图纸批量打印或输出为其他格式的文件,以便于传递给他人或进行进一步处理。
本文将介绍一些CAD批量打印与输出的技巧,帮助你更好地利用CAD软件进行工作。
首先,CAD软件通常提供了批量打印功能,可以帮助我们一次性打印多个图纸。
要使用这个功能,我们首先需要将需要打印的图纸整理到一个文件夹中,然后在CAD软件中选择批量打印选项。
接下来,我们需要设置打印参数,如纸张大小、打印机设置等。
在设置好参数后,我们可以选择要打印的图纸,然后点击打印按钮即可开始批量打印。
这样,我们就可以快速、方便地将多个图纸一次性打印出来。
除了批量打印,CAD软件还提供了多种输出格式的选择,如PDF、图像文件等。
这些输出格式的选择可以根据实际需要进行调整。
比如,如果我们需要将设计图纸发送给客户或同事,可以选择输出为PDF格式,以确保文件在不同平台上的兼容性。
如果需要在演示或报告中使用图纸,可以选择输出为图像文件(如JPEG或PNG),以便于将其插入到文档中。
CAD软件通常在输出选项中提供了这些选择,我们只需要根据需要进行设置即可。
另外,CAD软件还提供了一些高级的输出设置,帮助我们更好地控制输出效果。
比如,我们可以设置线条的颜色、线宽、字体样式等,以使输出的图纸更加清晰、易读。
还可以设置图纸的打印比例,以确保图纸在打印时不会有任何变形或缩放。
在输出之前,我们可以通过预览功能来查看图纸的最终效果,以便及时调整参数。
这些高级输出设置的使用需要一定的经验和技巧,但一旦掌握,将大大提高工作效率和输出质量。
此外,对于大型项目或需要频繁重复打印的图纸,CAD软件还提供了批量输出设置。
通过批量输出设置,我们可以将多个图纸同时进行打印或输出,而不需要逐个设置参数。
这对于一些固定格式的图纸(如尺寸相同、纸张大小相同等)特别有用。
自己用VBA编的批量打印程序(原创)

自己用VBA编的批量打印程序(原创)Option Explicit'图形集合Private colDwgs As New Collection'文档对象Dim objDoc As AcadDocument'布局对象Dim objLayout As AcadLayout'打印对象Dim objPlot As AcadPlotPrivate Type BrowseInfohOwner As LongpidlRoot As LongpszDisplayName As StringlpszTitle As StringulFlags As Longlpfn As LonglParam As LongiImage As LongEnd TypePrivate Const MAX_PATH = 260'代表ESC键Private Const VK_ESCAPE = &H1B'API函数的声明Private Declare Function SHBrowseForFolder Lib "shell32.dll" _Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) As LongPrivate Declare Function FindWindow Lib "user32" Alias"FindWindowA" (ByVal lpClassName As String, _ByVal lpWindowName As String) As LongPrivate Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal _pidl As Long, ByVal pszPath As String) As LongPrivate Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer' 功能:判断用户是否按下某一个键' 输入:代表键的常量(从API Viewer中获得)' 调用:API函数GetAsyncKeyState' 返回:如果用户按下了指定的键,返回True;否则返回False' 示例:' If CheckKey(&H1B) = True Then do sthPrivate Function CheckKey(lngKey As Long) As BooleanIf GetAsyncKeyState(lngKey) ThenCheckKey = TrueElseCheckKey = FalseEnd IfEnd FunctionPrivate Sub cboPaperSize_Change()'若组合框非空If cboPaperSize.Text <> "" Then' 设置图纸尺寸objLayout.CanonicalMediaName = cboPaperSize.Text' 显示图纸尺寸Call SetPlotZoneEnd IfEnd SubPrivate Sub cboPlotScale_Click()If cboPlotScale.Value TheneStandardScale = True '使用标准打印比例ElseeStandardScale = False '使用自定义打印比例End IfSelect Case cboPlotScale.ValueCase 0'txtNumerator = 1'txtDenominator = 1Case 1objLayout.StandardScale = acScaleToFit txtNumerator = 1txtDenominator = ""Case 2objLayout.StandardScale = ac1_1txtNumerator = 1txtDenominator = 1Case 3objLayout.StandardScale = ac1_2txtNumerator = 1txtDenominator = 2Case 4objLayout.StandardScale = ac1_4txtNumerator = 1txtDenominator = 4Case 5objLayout.StandardScale = ac1_8txtNumerator = 1txtDenominator = 8Case 6objLayout.StandardScale = ac1_10 txtNumerator = 1 txtDenominator = 10Case 7objLayout.StandardScale = ac1_16 txtNumerator = 1 txtDenominator = 16Case 8objLayout.StandardScale = ac1_20 txtNumerator = 1 txtDenominator = 20Case 9objLayout.StandardScale = ac1_30 txtNumerator = 1 txtDenominator = 30Case 10objLayout.StandardScale = ac1_40 txtNumerator = 1 txtDenominator = 40Case 11objLayout.StandardScale = ac1_50 txtNumerator = 1 txtDenominator = 50Case 12objLayout.StandardScale = ac1_100 txtNumerator = 1 txtDenominator = 100Case 13objLayout.StandardScale = ac2_1 txtNumerator = 2txtDenominator = 1Case 14objLayout.StandardScale = ac4_1txtNumerator = 4txtDenominator = 1Case 15objLayout.StandardScale = ac8_1txtNumerator = 8txtDenominator = 1Case 16objLayout.StandardScale = ac10_1txtNumerator = 10txtDenominator = 1Case 17objLayout.StandardScale = ac100_1txtNumerator = 100txtDenominator = 1End SelectEnd SubPrivate Sub cboPlotStyleTableNames_Change()' 设置打印样式表objLayout.StyleSheet = cboPlotStyleT ableNames.TextEnd SubPrivate Sub cboPrintersName_Change()On Error Resume Next' 设置打印机配置(对应AutoCAD中:打印>打印设备>打印机配置>"DWF6 ePlot.pc3")objLayout.ConfigName = cboPrintersName.Text' 更新显示AutoCAD中当前可用的所有图纸尺寸Call ListPaperSize' 更新显示AutoCAD中当前可用的所有打印样式表Call ListPlotStyleTableNamesEnd SubPrivate Sub chkCenterPlot_Change()Dim PtOffset(0 To 1) As Double' 设置图纸是否居中打印If chkCenterPlot.Value ThenPtOffset(0) = 0PtOffset(1) = 0ElsePtOffset(0) = -5PtOffset(1) = -5End IftxtOffsetX.Value = PtOffset(0)txtOffsetY.Value = PtOffset(1)End SubPrivate Sub chkPlotHidden_Change()'设置是否隐藏图纸空间对象If chkPlotHidden.Value Then'打印时隐藏图纸空间对象objLayout.PlotHidden = TrueElse'打印时不隐藏图纸空间对象objLayout.PlotHidden = FalseEnd IfEnd SubPrivate Sub chkPlotToFile_Change()'设置“打印到文件”组各控件激活状态If chkPlotT oFile.Value ThenlbPlotPath.Enabled = TruecboPlotPath.Enabled = TruecmdBrowse2.Enabled = TrueElselbPlotPath.Enabled = FalsecboPlotPath.Enabled = FalsecmdBrowse2.Enabled = FalseEnd IfEnd SubPrivate Sub chkPlotWithLineweights_Change() '设置是否打印对象线宽If chkPlotWithLineweights.Value Then'打印时使用图形文件中的线宽objLayout.PlotWithLineweights = TrueElse'打印时使用打印样式中的线宽objLayout.PlotWithLineweights = FalseEnd IfEnd SubPrivate Sub chkPlotWithPlotStyles_Change() '设置是否应用打印样式If chkPlotWithPlotStyles.Value Then'打印时在对象中使用打印样式objLayout.PlotWithPlotStyles = True chkPlotWithLineweights.Enabled = False Else'打印时在对象中不使用打印样式objLayout.PlotWithPlotStyles = False chkPlotWithLineweights.Enabled = TrueEnd IfEnd Sub' 设置图纸打印方向Call PaperRotationChangeEnd SubPrivate Sub cmdAdd_Click()'如果列表框中未存在任何元素If lstCurFiles.ListCount = 0 ThenMsgBox "请先向列表框中添加文件!", vbCritical Exit SubEnd IfDim strFlies As StringDim i As IntegerDim n As Integern = 0'将上面列表框中选中的对象添加到下面的列表框中For i = 0 To lstCurFiles.ListCount - 1If lstCurFiles.Selected(i) ThenstrFlies = lstCurFiles.List(i)n = n + 1If Not HasItem(lstPlotFiles, strFlies) Then lstPlotFiles.AddItem lstCurFiles.List(i) 'End IfEnd IfNext i'如果列表框中未存在被选择的元素If n = 0 ThenMsgBox "请选择要从列表中添加的元素!", vbCritical Exit SubEnd IfEnd Sub'如果列表框中未存在任何元素If lstCurFiles.ListCount = 0 ThenMsgBox "请先向列表框中添加文件!", vbCriticalExit SubEnd IfDim strFlies As StringDim i As Integer'将上面列表框中选中的对象添加到下面的列表框中For i = 0 To lstCurFiles.ListCount - 1strFlies = lstCurFiles.List(i)If Not HasItem(lstPlotFiles, strFlies) Then lstPlotFiles.AddItem lstCurFiles.List(i)End IfNext iEnd SubPrivate Sub cmdBrowse_Click()'在文本框中显示获得的路径txtCurPath.Text = ReturnFolder(0)End SubPrivate Sub cmdBrowse2_Click()Dim strPath As StringstrPath = ReturnFolder(0)'若返回文件夹路径非空If strPath <> "" Then'若组合框中未存在返回文件夹路径,则将其添加到组合框中If HasItem2(strPath) < 0 Then'在组合框中显示获得的路径With cboPlotPath.AddItem strPath, 0'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 0End With'若组合框中已存在返回文件夹路径,则将返回文件夹路径置为选中ElseWith cboPlotPath'设置默认的显示项目.ListIndex = HasItem2(strPath)End WithEnd IfEnd IfEnd SubPrivate Sub cmdClear_Click()'如果列表框中未存在任何元素If lstPlotFiles.ListCount = 0 ThenMsgBox "请先向列表框中添加文件!", vbCriticalExit SubEnd IfDim i As Integer, n As Integer, count As Integer'列表框中元素的数量count = lstPlotFiles.ListCountn = 0'将列表框中选中的对象删除For i = 0 To count - 1If lstPlotFiles.Selected(i) Thenn = n + 1Else'移动列表框中的元素lstPlotFiles.List(i - n) = lstPlotFiles.List(i)End IfNext i'如果列表框中未存在被选择的元素If n = 0 ThenMsgBox "请选择要从列表中清除的元素!", vbCritical Exit SubEnd If'删除最后n行的元素For i = 1 To nlstPlotFiles.RemoveItem (count - i)Next iEnd SubPrivate Sub cmdClearAll_Click()'如果列表框中未存在任何元素If lstPlotFiles.ListCount = 0 ThenMsgBox "请先向列表框中添加文件!", vbCriticalExit SubEnd IfDim Msg, Style, Title, Help, Ctxt, Response, MyStringMsg = "清除整个图形列表?"Style = vbOKCancel + vbQuestion + vbDefaultButton2 Title = "Clear Files"Response = MsgBox(Msg, Style, Title)If Response = vbOK ThentxtCurPath.Text = ""'清除列表框中所有元素lstPlotFiles.ClearEnd IfEnd SubPrivate Sub cmdExit_Click()'退出EndEnd SubPrivate Sub cmdInput_Click()'导入打印设置'设置标准对话框With comDlg'设置标准对话框标题.DialogTitle = "导入打印设置"'设置标准对话框类型列表中所显示的过滤器.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"'设置标准对话框的起始目录'.InDir = "C:\"'显示[打开]对话框.ShowOpenEnd WithDim strFileName As StringstrFileName = comDlg.fileName'strFileName = "F:\AutoCAD\丹通施工图\打印设置.txt" '若返回文件名为空,不进行操作If strFileName = "" ThenMsgBox "请重新选择文件位置!"Exit SubEnd If'读入文件的操作Dim i As Integer, nFile As IntegerDim x As Double, y As DoubleDim count As Integer, index As IntegerDim strTemp As String'获得下一个可供Open语句使用的文件号nFile = FreeFile'打开文件Open strFileName For Input As #nFile'读入当前路径'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入当前路径并设置文本框文字Input #nFile, strTemptxtCurPath.Text = strTemp'读入打印文件列表并添加到列表框中Call InputData3(lstPlotFiles, nFile)'读入打印机配置列表并添加到组合框中Call InputData(cboPrintersName, nFile)'读入打印样式表并添加到组合框中Call InputData(cboPlotStyleTableNames, nFile)'读入图纸尺寸列表并添加到组合框中Call InputData(cboPaperSize, nFile)'读入图纸单位并设置单选按钮选择状态'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入图纸单位Input #nFile, strTemp'设置单选按钮选择状态If strTemp = "毫米" Then optMillimeters.Value = TrueElseoptInches.Value = TrueEnd If'读入图纸方向并设置单选按钮选择状态'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入图纸方向Input #nFile, strTemp'设置单选按钮选择状态If strTemp = "纵向" ThenoptVertical.Value = TrueElseoptHorizontal.Value = TrueEnd If'读入是否反向打印并设置复选按钮选择状态Call InputData2(chkReverse, nFile)'读入打印份数'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入打印份数Input #nFile, count'设置文本框文字txtNumber.Text = count'读入是否打印到文件并设置复选按钮选择状态Call InputData2(chkPlotToFile, nFile)'读入打印路径列表并添加到组合框中Call InputData(cboPlotPath, nFile)'读入打印比例列表并添加到组合框中Call InputData(cboPlotScale, nFile)'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入当前打印比例并设置文本框文字Input #nFile, xInput #nFile, ytxtNumerator.Text = xtxtDenominator.Text = y'读入是否居中打印并设置复选按钮选择状态Call InputData2(chkCenterPlot, nFile)'读入打印偏移'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入打印偏移并设置文本框文字Input #nFile, xInput #nFile, ytxtOffsetX.Text = xtxtOffsetY.Text = y'读入是否打印对象线宽并设置复选按钮选择状态Call InputData2(chkPlotWithLineweights, nFile) '读入是否采用打印样式并设置复选按钮选择状态Call InputData2(chkPlotWithPlotStyles, nFile)'读入是否隐藏图纸空间对象并设置复选按钮选择状态Call InputData2(chkPlotHidden, nFile)'读入图框形式并设置单选按钮选择状态'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入图框形式Input #nFile, strTemp'设置单选按钮选择状态If strTemp = "图块" ThenoptBlock.Value = TrueElseoptLayer.Value = TrueEnd If'读入图块名列表并添加到组合框中Call InputData(cboBlockName, nFile)'读入图层名列表并添加到组合框中Call InputData(cboLayerName, nFile)'关闭文件Close #nFileEnd SubPrivate Sub cmdListPrints_Click()' 显示AutoCAD中当前可用的打印机列表Call ListPrintersEnd SubPrivate Sub cmdOutput_Click()'导出打印设置'设置标准对话框With comDlg'设置标准对话框标题.DialogTitle = "导出打印设置"'设置标准对话框类型列表中所显示的过滤器.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*" '设置标准对话框的起始目录'.InDir = "C:\"'设置[另存为]对话框的缺省扩展名.DefaultExt = "txt"'显示[另存为]对话框.ShowSaveEnd WithDim strFileName As String, strTemp As String strFileName = comDlg.fileName'strFileName = "F:\AutoCAD\丹通施工图\打印设置.txt" '若返回文件名为空,不进行操作If strFileName = "" ThenMsgBox "请重新选择保存位置!"Exit SubEnd If'保存文件的操作Dim i As Integer'打开文件Open strFileName For Output As #1'输出当前路径Print #1, "当前路径:"Print #1, txtCurPath.Text'输出打印文件列表Print #1, "打印文件列表:"'输出打印机配置列表的信息Call OutputData3(lstPlotFiles, 1)'输出打印机配置Print #1, "打印机配置:"'输出打印机配置列表的信息Call OutputData(cboPrintersName, 1)Print #1, "打印样式表:"'输出打印样式表的信息Call OutputData(cboPlotStyleTableNames, 1)'输出图纸尺寸列表Print #1, "图纸尺寸列表:"'输出图纸尺寸列表的信息Call OutputData(cboPaperSize, 1)'输出图纸单位Print #1, "图纸单位:"'输出图纸单位信息If optMillimeters.Value = True Then strTemp = "毫米"ElsestrTemp = "英寸"End IfPrint #1, strTemp'输出图纸方向Print #1, "图纸方向:"'输出图纸方向信息If optVertical.Value = True ThenstrTemp = "纵向"ElsestrTemp = "横向"End IfPrint #1, strTempPrint #1, "是否反向打印:"Call OutputData2(chkReverse, 1)'输出打印份数Print #1, "打印份数:"Print #1, txtNumber.Text'输出是否打印到文件Print #1, "是否打印到文件:"Call OutputData2(chkPlotToFile, 1)'输出打印路径Print #1, "打印路径:"'输出打印路径列表的信息Call OutputData(cboPlotPath, 1)'输出打印比例Print #1, "打印比例:"'输出打印比例列表的信息Call OutputData(cboPlotScale, 1)'输出当前打印比例Print #1, "当前打印比例:"Print #1, txtNumerator.TextPrint #1, txtDenominator.Text'输出是否居中打印Print #1, "是否居中打印:"Call OutputData2(chkCenterPlot, 1)'输出打印偏移Print #1, "打印偏移:"Print #1, txtOffsetX.TextPrint #1, txtOffsetY.Text'输出是否打印对象线宽Print #1, "是否打印对象线宽:"Call OutputData2(chkPlotWithLineweights, 1) '输出是否采用打印样式Print #1, "是否采用打印样式:"Call OutputData2(chkPlotWithPlotStyles, 1) '输出是否隐藏图纸空间对象Print #1, "是否隐藏图纸空间对象:"Call OutputData2(chkPlotHidden, 1)'输出图框形式Print #1, "图框形式:"'输出图框形式信息If optBlock.Value = True ThenstrTemp = "图块"ElsestrTemp = "图层"End IfPrint #1, strTemp'输出图块名列表Print #1, "图块名列表:"'输出图块名列表的信息Call OutputData(cboBlockName, 1)'输出图层名列表Print #1, "图块名列表:"'输出图层名列表的信息Call OutputData(cboLayerName, 1)'关闭文件Close 1End SubPrivate Sub cmdPick_Click()On Error Resume NextDim objSelect As AcadEntityDim ptPick As VariantDim strTemp As StringSet objDoc = ThisDrawing.Application.ActiveDocument'将控制权交给AutoCADfrmBatchPlot.Hide'在AutoCAD中选择实体并判断类型Retry:objDoc.Utility.GetEntity objSelect, ptPick, vbCrLf & "请选择实体:"' 处理按下Esc键的错误If objSelect Is Nothing ThenIf CheckKey(VK_ESCAPE) = True Then'显示对话框frmBatchPlot.ShowExit SubElseGoTo RetryEnd IfEnd If' 处理未选择到实体的错误If Err <> 0 ThenErr.ClearGoTo RetryEnd If'若为指定图块If optBlock.Value = True Then'判断实体是否块参照If TypeOf objSelect Is AcadBlockReference Then'判断实体是否模型空间、图纸空间和匿名块If StrComp(Left(, 1), "*") <> 0 Then'获得块参照名strTemp = ElseMsgBox "您选择的是匿名块,请重新选择块参照!", vbCritical '显示对话框frmBatchPlot.ShowExit SubEnd IfElseMsgBox "您选择的不是块参照,请重新选择块参照!", vbCritical'显示对话框frmBatchPlot.ShowExit SubEnd If'刷新块参照列表Call ListBlock'将所选块参照在组合框中置为当前Call SetSelected(cboBlockName, strTemp)Else'判断实体是否多段线If TypeOf objSelect Is AcadLWPolyline Then'获得多段线所在图层名strTemp = yerElseMsgBox "您选择的不是轻量多段线,请重新选择轻量多段线!", vbCritical'显示对话框frmBatchPlot.ShowExit SubEnd If' 刷新图层列表Call ListLayer'将所选实体所在图层在组合框中置为当前Call SetSelected(cboLayerName, strTemp)End If'显示对话框frmBatchPlot.ShowEnd SubPrivate Sub SetSelected(ListObject As Object, SItem As String) '将该元素在组合框中置为当前Dim i As Long'通过比较确定该元素的位置For i = 0 To (ListObject.ListCount - 1)If StrComp(ListObject.List(i), SItem, vbTextCompare) = 0 ThenListObject.ListIndex = iExit SubEnd IfNextEnd SubPrivate Sub cmdPreview_Click()'若按图块进行批量打印If optBlock.Value = True ThenIf cboBlockName.ListCount = 0 Or cboBlockName.Text = "" ThenMsgBox "请先选择块参照!", vbCriticalExit SubEnd IfCall PreviewByBlock(cboBlockName.T ext)'若按图层进行批量打印ElseIf cboLayerName.ListCount = 0 Or cboLayerName.Text = "" ThenMsgBox "请先选择块参照!", vbCriticalExit SubEnd IfCall PreviewByLayer(cboLayerName.T ext)End IfEnd SubPrivate Sub cmdRefresh_Click()'刷新块参照列表Call ListBlock' 刷新图层列表Call ListLayerEnd SubPrivate Sub cmdPlot_Click()'若按图块进行批量打印If optBlock.Value = True ThenIf cboBlockName.ListCount = 0 Or cboBlockName.Text = "" ThenMsgBox "请先选择块参照!", vbCriticalExit SubEnd IfCall BatchPlotByBlock(cboBlockName.Text)'若按图层进行批量打印ElseIf cboLayerName.ListCount = 0 Or cboLayerName.Text = "" ThenMsgBox "请先选择块参照!", vbCriticalExit SubEnd IfCall BatchPlotByLayer(cboLayerName.Text)End IfEnd SubPrivate Sub cmdAbout_Click()'显示关于对话框frmAbout.ShowEnd SubPrivate Sub optBlock_Change()'设置“图块与图层”组各控件激活状态If optBlock.Value = True ThenlbBlockName.Enabled = TruecboBlockName.Enabled = TruelbLayerName.Enabled = False cboLayerName.Enabled = False ElselbBlockName.Enabled = False cboBlockName.Enabled = False lbLayerName.Enabled = True cboLayerName.Enabled = TrueEnd IfEnd SubPrivate Sub optLayer_Change()'设置“图块与图层”组各控件激活状态If optBlock.Value = True Then lbBlockName.Enabled = True cboBlockName.Enabled = True lbLayerName.Enabled = False cboLayerName.Enabled = False ElselbBlockName.Enabled = False cboBlockName.Enabled = False lbLayerName.Enabled = True cboLayerName.Enabled = TrueEnd IfEnd SubPrivate Sub optMillimeters_Change() ' 设置图纸单位If optMillimeters.Value = True Then objLayout.PaperUnits = acMillimeters lbUnit.Caption = "毫米=" lbUnitX.Caption = "毫米" lbUnitY.Caption = "毫米"lbPaperUnit.Caption = "毫米"ElseobjLayout.PaperUnits = acInches lbUnit.Caption = "英寸="lbUnitX.Caption = "英寸"lbUnitY.Caption = "英寸" lbPaperUnit.Caption = "英寸"End If' 显示图纸尺寸Call SetPlotZoneEnd SubPrivate Sub OptVertical_Change()' 设置图纸打印方向Call PaperRotationChangeEnd SubPrivate Sub spnAngle_SpinDown()If CInt(txtNumber.T ext) > 1 Then txtNumber.Text = CInt(txtNumber.Text) - 1 End IfEnd SubPrivate Sub spnAngle_SpinUp() txtNumber.Text = CInt(txtNumber.Text) + 1 End SubPrivate Sub txtCurPath_Change()'查找文件,向列表框中添加If Len(Dir(txtCurPath.Text)) > 0 Then FindFile colDwgs, txtCurPath.Text, "dwg" If AddToList(lstCurFiles, colDwgs) Then End IfEnd IfEnd SubPrivate Sub txtDenominator_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)' 设置自定义图纸尺寸If IsNumeric(txtDenominator) Then'设置组合框显示项目为“自定义”cboPlotScale.ListIndex = 0ElseMsgBox "请输入数字!", vbCriticalEnd IfEnd SubPrivate Sub txtNumber_Change()' 设置图纸打印份数'objPlot.NumberOfCopies = CDbl(txtNumber.Text)'objPlot.NumberOfCopies = CInt(txtNumber.Text)objPlot.NumberOfCopies = txtNumber.ValueEnd SubPrivate Sub txtNumerator_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)' 设置自定义图纸尺寸If IsNumeric(txtNumerator) Then'设置组合框显示项目为“自定义”cboPlotScale.ListIndex = 0ElseMsgBox "请输入数字!", vbCriticalEnd IfEnd SubPrivate Sub txtOffsetX_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)' 设置自定义图纸尺寸If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Or KeyAscii = Asc(".") Or KeyAscii = Asc("-") Then'取消“居中打印”复选框chkCenterPlot.Value = FalseElseMsgBox "请输入数字!", vbCriticalEnd IfEnd SubPrivate Sub txtOffsetY_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)' 设置自定义图纸尺寸If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Or KeyAscii = Asc(".") Or KeyAscii = Asc("-") Then'取消“居中打印”复选框chkCenterPlot.Value = FalseElseMsgBox "请输入数字!", vbCriticalEnd IfEnd SubPrivate Sub UserForm_Initialize()Set objDoc = ThisDrawing.Application.ActiveDocumentSet objLayout = ThisDrawing.ActiveLayoutSet objPlot = ThisDrawing.Plot'禁用“当前路径”文本框txtCurPath.Enabled = False'列出当前所有打印机Call ListPrinters' 显示AutoCAD中当前可用的打印比例列表Call ListPlotScale'设置“打印到文件”是否选中chkPlotToFile.Value = False'禁用“打印到文件”组各控件lbPlotPath.Enabled = FalsecboPlotPath.Enabled = FalsecmdBrowse2.Enabled = False' 显示AutoCAD中当前可用的图块Call ListBlock' 显示AutoCAD中当前可用的图层Call ListLayerEnd SubPublic Function ReturnFolder(lngHwnd As Long) As String Dim Browser As BrowseInfoDim lngFolder As LongDim strPath As StringDim strTemp As StringWith Browser.hOwner = lngHwnd.lpszTitle = "选择工作路径".pszDisplayName = String(MAX_PATH, 0)End With'用空格填充字符串strPath = String(MAX_PATH, 0)'调用API函数显示文件夹列表lngFolder = SHBrowseForFolder(Browser)'使用API函数获取返回的路径If lngFolder ThenSHGetPathFromIDList lngFolder, strPathstrTemp = Left(strPath, InStr(strPath, vbNullChar) - 1)If (Right(strTemp, 1) <> "\") ThenstrTemp = strTemp & "\"End IfReturnFolder = strTempEnd IfEnd FunctionPublic Sub FindFile(ByRef files As Collection, strDir, strExt) '删除集合中所有的对象Dim i As IntegerFor i = 1 To files.countfiles.Remove 1Next i'查找dwg文件,并将其添加到集合中Dim strFileName As StringIf (Right(strDir, 1) <> "\") ThenstrDir = strDir & "\"End IfstrFileName = Dir(strDir & "*.*", vbDirectory)Do While (strFileName <> "")If (UCase(Right(strFileName, 3)) = UCase(strExt)) Thenfiles.Add strDir & strFileNameEnd IfstrFileName = Dir '返回下一个符合条件的文件LoopEnd SubPublic Function AddToList(objBox As ListBox, Names As Collection) As BooleanDim i As IntegerOn Error GoTo Error_ControlobjBox.Clear'将集合中的对象添加到列表框中For i = 1 To Names.countobjBox.AddItem Names(i)Next iExit_Here:AddToList = TrueExit FunctionError_Control:MsgBox "发生下面的错误:" & Err.NumberAddToList = FalseEnd FunctionPrivate Function HasItem(objBox As ListBox, strFlies As String) As Boolean'检查路径是否已经存在HasItem = FalseDim i As IntegerIf objBox.ListCount > 0 ThenFor i = 0 To objBox.ListCount - 1If StrComp(objBox.List(i), strFlies, vbT extCompare) = 0 Then HasItem = TrueExit FunctionEnd IfNext iEnd IfEnd FunctionPrivate Function HasItem2(ByVal strPath As String) As Integer'检查路径是否已经存在HasItem2 = -1Dim i As IntegerIf cboPlotPath.ListCount > 0 ThenFor i = 0 To cboPlotPath.ListCount - 1If StrComp(cboPlotPath.List(i), strPath, vbTextCompare) = 0 ThenHasItem2 = iExit FunctionEnd IfNext iEnd IfEnd Function'打开或激活文件Private Sub OpenFile(fileName As String)Dim dwgFile As AcadDocumentDim strFile As StringFor Each dwgFile In ThisDrawing.Application.Documents strFile = dwgFile.Path & "\" & '若第i个图形文件已经被打开,则将其激活If strFile = fileName Then'若dwgFile尚未激活,则将其激活If dwgFile.Active = False ThenThisDrawing.Application.ActiveDocument = dwgFile End IfExit SubEnd IfNext'若第i个图形文件尚未被打开,则将其打开ThisDrawing.Application.Documents.Open fileNameEnd Sub' 显示AutoCAD中当前可用的打印机列表Public Sub ListPrinters()objLayout.RefreshPlotDeviceInfo' 获得所有的可用打印机Dim plotDevices As VariantplotDevices = objLayout.GetPlotDeviceNames' 删除以前的打印机列表cboPrintersName.Clear' 显示打印机列表Dim i As IntegerFor i = 0 To UBound(plotDevices) cboPrintersName.AddItem (plotDevices(i))Next i' 设置组合框初始选项With cboPrintersName'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 1End WithEnd Sub' 显示AutoCAD中当前可用的打印样式Public Sub ListPlotStyleTableNames()Set objLayout = ThisDrawing.ActiveLayout objLayout.RefreshPlotDeviceInfo' 获得所有的可用打印样式Dim plotStyleTables As VariantplotStyleTables = objLayout.GetPlotStyleTableNames' 删除以前的打印样式列表cboPlotStyleTableNames.Clear' 显打印样式列表Dim i As IntegerFor i = 0 To UBound(plotStyleTables) cboPlotStyleTableNames.AddItem (plotStyleTables(i)) Next i' 设置组合框初始选项With cboPlotStyleT ableNames'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 0End WithEnd Sub' 显示AutoCAD中当前可用的图纸尺寸Public Sub ListPaperSize()objLayout.RefreshPlotDeviceInfo' 获得所有当前可用可用图纸尺寸列表Dim paperSizes As VariantpaperSizes = objLayout.GetCanonicalMediaNames' 删除以前的图纸尺寸列表cboPaperSize.Clear' 显示图纸尺寸列表Dim i As IntegerFor i = 0 To UBound(paperSizes) cboPaperSize.AddItem (paperSizes(i))Next i' 设置组合框初始选项With cboPaperSize'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 0End WithEnd Sub' 显示AutoCAD中可以使用的打印比例Public Sub ListPlotScale()' 显打印比例列表With cboPlotScale.AddItem ("自定义"), 0.AddItem ("按图纸空间缩放"), 1.AddItem ("1:1"), 2.AddItem ("1:2"), 3.AddItem ("1:4"), 4.AddItem ("1:8"), 5.AddItem ("1:10"), 6.AddItem ("1:16"), 7.AddItem ("1:20"), 8.AddItem ("1:30"), 9.AddItem ("1:40"), 10.AddItem ("1:50"), 11.AddItem ("1:100"), 12.AddItem ("2:1"), 13.AddItem ("4:1"), 14.AddItem ("8:1"), 15.AddItem ("10:1"), 16.AddItem ("100:1"), 17'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 2End WithtxtNumerator = 1txtDenominator = 1End Sub' 显示AutoCAD中当前可用的图层Public Sub ListLayer()Dim LayerList As Collection'获得图形中存在的图层列表Set LayerList = GetLayerList()'刷新图层列表Call RefreshList(cboLayerName, LayerList)'选择图层列表中的第一个实体If cboLayerName.ListIndex = -1 Then cboLayerName.ListIndex = 0End IfEnd Sub'获得图形中存在的图层列表Private Function GetLayerList() As Collection Dim objLayer As AcadLayerDim LayerList As New CollectionSet objDoc = ThisDrawing.Application.ActiveDocument '获得可用的图层For Each objLayer In yersLayerList.Add , Next'返回图形中块参照的列表Set GetLayerList = LayerListEnd Function' 显示AutoCAD中当前可用的图块Public Sub ListBlock()Dim BlockReferenceList As Collection'获得图形中存在的块参照列表Set BlockReferenceList = GetBlockReferences()'判断是否存在块参照If BlockReferenceList Is Nothing ThenMsgBox "当前图形中不存在任何的块!", vbExclamation Exit SubEnd If'刷新块参照列表Call RefreshList(cboBlockName, BlockReferenceList)'选择块参照列表中的第一个实体If cboBlockName.ListIndex = -1 Then cboBlockName.ListIndex = 0End If。
cad批处理打印用法

CAD批处理打印是一种自动化打印工具,可以大大提高CAD图纸的打印效率。
它能够同时处理多个文件,并按照指定的顺序进行打印,避免了手动操作的一系列繁琐步骤。
以下是使用CAD批处理打印的一些用法:首先,需要确保已经安装了AutoCAD软件和相应的打印驱动程序。
然后,创建一个批处理文件,将多个CAD图纸文件和打印选项打包到一个文件中,可以实现自动化批量打印。
具体步骤如下:1. 打开AutoCAD软件,新建一个空白文件。
2. 选择“插入”菜单下的“批处理打印”选项,或者使用快捷键“Alt+T P”打开“打印”对话框。
3. 在“打印”对话框中,设置打印机、纸张大小、布局等打印选项。
如果已经有了打印机驱动程序,可以直接在“打印机”下拉菜单中选择,如果没有,可以在这里下载并安装。
4. 添加需要打印的CAD图纸文件。
可以直接将文件拖拽到“图纸”框格中,或者通过文件名将文件导入。
5. 根据需要,可以对每个图纸进行排序和编号。
可以选择“顺序”下拉菜单中的“按顺序”,并选择是否添加编号。
6. 完成上述设置后,点击“确定”按钮,即可开始打印过程。
在打印过程中,可以继续添加其他图纸或修改设置,但必须确保在打印完成后关闭所有打开的文件。
7. 在打印完成后,可以保存批处理文件为“.bat”格式,以便于下次使用。
需要注意的是,使用CAD批处理打印时,需要确保打印机和相关驱动程序正确安装,并且与AutoCAD软件兼容。
此外,打印选项和图纸文件的顺序、编号等设置可以根据具体需求进行调整。
此外,还可以通过一些第三方工具或插件来实现CAD图纸的批量打印。
这些工具通常具有更丰富的功能和更好的灵活性,可以根据具体需求进行定制和优化。
总之,CAD批处理打印是一种非常实用的工具,可以大大提高CAD图纸的打印效率,减少手工操作的繁琐步骤。
通过正确设置和合理使用,可以更好地满足不同场景下的打印需求。
autocad批量打印怎么用 autocad如何一键批量打印所有图纸

autocad批量打印怎么用autocad如何一键批量打印所有图
纸
autocad作为一款最出名的cad软件,很多制图的小伙伴都会用到它,但是在使用的过程中会遇到一些问题,这不就有小伙伴问小编autocad批量打印怎么用,不要着急,小编为大家准备好了autocad如何一键批量打印所有图纸的方法,大家有需要的话可以来系统城看看哦。
autocad批量打印怎么用?
具体步骤如下:
1.双击打开AutoCAD进入编辑界面;
2.在界面左上方点击AutoCAD图标处的下拉箭头后,将鼠标悬停到“打印”,然后在子选项中点击“批处理打印”;
3.在新打开的窗口中右键点击一下,选择“添加图注”后在新打开的窗口中选择需要打开的图纸,然后点击“选择”按钮;
4.接着在“发布为”处的下拉箭头后选择需要的方式,比如我们这里选择“页面设置中指定的绘图仪”,然后点击“发布”就可以了。
以上就是小编为大家带来的autocad批量打印怎么用的方法了,希望能帮助到大家。
cad批量打印总结VBA

cad批量打印总结VBAcad vb及批量打印cad二次开发中VB或VBA的应用问题1、如何在 VB 中连接 AutoCAD。
启动VB ,引用 AutoCAD 类型库。
操作步骤:从“工程”菜单中选择“引用”选项,启动“引用”对话框。
在“引用”对话框中,选择 AutoCAD 类型库,然后单击“确定”。
2、定义模块级变量 AutoCAD 应用程序 (acadApp) 和当前的文档(acadDoc)。
如果 AutoCAD 正在运行,使用 GetObject 函数将检索 AutoCAD Application 对象。
如果 AutoCAD 没有运行,使用 CreateObject 函数试图创建一个 AutoCAD Application 对象。
如果创建成功,会启动 AutoCAD;如果失败,则会发生错误。
同时运行多个 AutoCAD 任务时,GetObject 函数会返回 Windows 运行对象表中的第一个 AutoCAD 实例。
要显示 AutoCAD 图形窗口,需要将AutoCAD 应用程序的 Visible 特性设置为 TRUE。
使用 acadDoc 变量引用当前的AutoCAD 图形。
示例: Dim acadApp As AcadApplicationDim acadDoc as AcadDocument Sub ConnectToAcad()OnError Resume NextSet acadApp = GetObject(, "AutoCAD.Application")If ErrThenErr.ClearSet acadApp = CreateObject("AutoCAD.Application")If Err Then EndEndIfacadApp.Visible = TrueSet acadDoc = acadApp.ActiveDocumentEndSub2、如何使 VB 开发的程序不依赖于 AutoCAD 的版本。
cad怎么批量打印图纸

cad怎么批量打印图纸CAD(计算机辅助设计)是一种强大的工具,广泛用于制图、设计和建模等领域。
在工程项目中,有时需要打印大量的图纸。
为了提高效率,CAD软件提供了批量打印功能,可以一次打印多个图纸。
本文将介绍如何在CAD中批量打印图纸,并提供一些实用的技巧。
首先,要使用CAD软件进行批量打印,需要准备好需要打印的图纸。
这些图纸可以是单个文件,也可以是一系列或者一个文件夹中的多个文件。
将这些图纸准备好后,我们开始介绍如何进行批量打印。
第一步,打开CAD软件,并进入打印布局界面。
在CAD软件中,打印布局界面通常称为“模型空间”或者“纸空间”。
选择进入模型空间,可以看到CAD的绘图界面。
第二步,选择并加载需要打印的图纸。
在CAD的模型空间中,可以通过拖拽、复制粘贴或者导入图纸文件的方式加载图纸。
将需要打印的图纸加载到模型空间中。
第三步,创建打印布局。
在CAD的模型空间中,可以创建多个打印布局,每个打印布局对应着一张图纸。
在打印布局中,可以设置打印纸张的大小、方向、缩放比例等参数。
第四步,将模型空间的图纸导入到打印布局中。
在CAD的打印布局中,可以将模型空间的图纸导入到相应的打印布局中。
选择需要导入的图纸,并将其拖拽或者复制粘贴到打印布局中。
第五步,设置打印参数。
在CAD的打印布局中,可以设置打印的参数,包括打印纸张的大小、方向、打印机的选择等。
根据需要,设置相应的打印参数。
第六步,预览并调整打印布局。
在CAD的打印布局中,可以进行预览,并对打印布局进行调整。
可以调整图纸的位置、缩放比例等,以确保打印效果满意。
第七步,保存并批量打印。
在CAD的打印布局中,将所有需要打印的布局保存起来,并选择“批量打印”选项。
CAD软件会自动打开打印队列,并按照设置的参数批量打印图纸。
除了上述操作,以下是一些实用的技巧,可以进一步提高CAD批量打印的效率:1. 使用CAD的命令行工具。
CAD软件通常提供命令行工具,可以通过输入命令的方式批量进行操作。
CAD图纸批量打印与发布技巧

CAD图纸批量打印与发布技巧CAD软件是建筑设计师和工程师最常用的工具之一。
在设计完成后,经常需要将图纸打印出来以便审阅和施工。
本文将介绍CAD图纸的批量打印与发布技巧,帮助读者提高工作效率和减少错误。
首先,我们需要将设计好的CAD图纸保存为适当的文件格式。
常见的格式包括DWG和PDF。
DWG格式适用于CAD软件内部使用,而PDF格式则方便与其他人共享。
因此,建议将图纸保存为DWG格式作为备份,同时导出为PDF格式供打印和发布使用。
接下来,我们需要设置图纸的一些打印参数。
在CAD软件中,可以通过打开“打印设置”对话框来完成这个步骤。
在这里,我们可以选择打印机、纸张大小、打印比例和布局等选项。
不同纸张大小和打印比例可以根据需要进行调整。
如果需要打印多个图纸,则可以选择“批量打印”选项。
批量打印是一种非常方便的功能,可以一次性打印多个图纸。
在CAD软件的“批处理”菜单中,可以选择“批量打印”选项。
在弹出的对话框中,我们可以选择要打印的图纸文件的位置,并设置一些打印参数。
比如,我们可以选择是否要打印所有图层,是否要将图纸自动居中,以及是否需要打印图纸的日期和时间等信息。
在设置完批量打印参数后,我们可以点击“开始”按钮开始打印。
CAD软件将自动按照事先设定的参数,逐个打印每个图纸文件。
在打印过程中,我们可以通过查看进度条来了解当前打印的情况。
同时,CAD软件还会显示打印的日志信息,方便用户追踪每个图纸的打印状态。
除了批量打印,CAD软件还提供了一些发布图纸的功能。
发布是指将图纸保存为一系列的文件,并可以方便地导出到其他格式。
在CAD 软件的“发布”菜单中,我们可以选择“发布到PDF”或“发布到DWF”选项。
PDF格式适合与他人共享,而DWF格式则适合用于网络浏览和在线审阅。
在选择发布格式后,我们需要设置一些发布参数。
比如,我们可以选择要发布的图纸文件的位置和输出文件夹的位置。
同时,可以选择是否要发布所有图层,是否要压缩文件以减小文件大小,以及是否要包含外部参照和字体等内容。
- 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。
打印图纸,不折不扣的体力活。
最多一次打了600多张图,打印机都因"体力不支"中途休息了几次,如果不是用程序批打,估计我也得累个半死。
下面贴出打印过程的代码,加个for循环就可以批打了。
简单说明一下打印函数PrinterName - 打印机名称Styles - 样式表名称MediaName - 纸张大小Copies - 打印份数AutoMedia - 自动纸张开关AutoRotate - 自动旋转,纵向/横向AutoClose - 打印完毕关闭文档AutoFrame - 自动判断图框,主要针对图框为块的情形打印过程并没有提供全部的AUTO CAD打印选项,因为我一般用不到,比如"打印偏移"、"打印到文件"我从来不用的,如果需要可以添加进去。
程序会根据指定块名查找图框,也可以根据块的纵横比例自动判断是否为图框,然后按块打印,一张图纸中允许有多个图框;对于编组(Group)形式的图框,指定编组名即可如果没有找到任何图框块或编组时,按图纸范围打印另外,打印时会先预览,然后由用户选择是否打印,避免打错。
[代码如下] - By:忽又一天/suddenday/Sub QuickPlot()Call PlotFunction("SHARP AR-M256", "", "A3", 1, True, True, False, True)End SubSub Plot2PDF()Call PlotFunction("pdfFactory Pro", "acad.ctb", "", 1, True, True, False, True)End SubSub PlotA4()Call PlotFunction("SHARP AR-M256", "acad.ctb", "A4", 1, False, True, False, True) End Sub'快速打印/批量打印Public Sub PlotFunction(PrinterName As String, Styles As String, MediaName As String, Copies As Integer, _AutoMedia As Boolean, AutoRotate As Boolean, AutoClose As Boolean, AutoFrame As Boolean)On Error Resume NextDim ptMin As Variant, ptMax As VariantDim Ent As AcadEntityDim PlotCount As IntegerSet objDoc = ThisDrawing.Application.ActiveDocumentSet objLayout = youts.Item("Model")Set objPlot = objDoc.PlotThisDrawing.Application.ZoomExtents' 设置打印机If Not Trim(PrinterName) = ""ThenobjLayout.ConfigName = PrinterNameElseExit SubEnd If' 设置打印样式表If Not Trim(Styles) = ""ThenobjLayout.StyleSheet = StylesElseobjLayout.StyleSheet = "acad.ctb"End If' 设置图纸尺寸If AutoMedia ThenobjLayout.CanonicalMediaName = "A3"ElseIf Not Trim(MediaName) = ""ThenobjLayout.CanonicalMediaName = MediaNameElseobjLayout.CanonicalMediaName = "A3"End IfEnd If' 设置图纸单位objLayout.PaperUnits = acMillimeters'objLayout.PaperUnits = acInches' 设置默认图纸打印方向'objLayout.PlotRotation = ac0degrees '纵向'objLayout.PlotRotation = ac180degreesobjLayout.PlotRotation = ac90degrees '横向'objLayout.PlotRotation = ac270degrees' 设置图纸打印比例objLayout.StandardScale = acScaleToFiteStandardScale = True'使用标准打印比例'eStandardScale = False '使用自定义打印比例' 设置自定义打印比例'objLayout.SetCustomScale txtNumerator.Value, txtDenominator.Value' 设置图纸是否居中打印objLayout.CenterPlot = True' 打印时使用图形文件中的线宽objLayout.PlotWithLineweights = True' 设置是否应用打印样式objLayout.PlotWithPlotStyles = True' 打印时隐藏图纸空间对象objLayout.PlotHidden = False' 设置图纸打印份数If Copies >= 1 ThenobjPlot.NumberOfCopies = CInt(Copies)ElseobjPlot.NumberOfCopies = 1End If' 将打印错误报告切换为静默错误模式,以便不间断地执行打印任务objPlot.QuietErrorMode = True' 重新生成当前图形objDoc.Regen acAllViewports' 设置前台打印,使打印任务按打印顺序依次发送到打印机objDoc.SetVariable "BACKGROUNDPLOT", 0PlotCount = 0 '打印计数For Each Ent In objDoc.ModelSpaceIf TypeOf Ent Is AcadBlockReference ThenIf IsFrame(Ent, AutoFrame) = True And objDoc.Blocks().count > 0 Then Ent.GetBoundingBox ptMin, ptMaxDebug.Print & "--" & objDoc.Blocks().count' 将三维点转化为二维点坐标ReDim Preserve ptMin(0 To 1)ReDim Preserve ptMax(0 To 1)' 设置打印窗口ThisDrawing.ActiveLayout.SetWindowToPlot ptMin, ptMaxobjLayout.PlotType = acWindowIf Abs(ptMax(0) - ptMin(0)) < Abs(ptMax(1) - ptMin(1)) ThenIf AutoMedia Then objLayout.CanonicalMediaName = "A4"If AutoRotate Then objLayout.PlotRotation = ac0degreesEnd If' 完全预览并提示打印objPlot.DisplayPlotPreview acFullPreviewUserSel = MsgBox("是否打印预览?" & Chr(13) & Chr(13) & "打印到:" & objLayout.ConfigName & _" 大小:" & objLayout.CanonicalMediaName & " 方式:acWindow(" & objLayout.PlotType & ") " & _Chr(13) & Chr(13) & "选择[取消]退出程序!", vbYesNoCancel, "打印选项") If UserSel = vbYes ThenobjPlot.PlotToDevice objLayout.ConfigNamePlotCount = PlotCount + 1ElseIf UserSel = vbCancel ThenExit ForEnd IfEnd IfEnd IfNext Ent' 图框为编组(Group)对象时Dim FrmGrp As AcadGroupDim TptMin, TptMax As Variant' 按编组名称查找图框编组对象For Each FrmGrp In ThisDrawing.GroupsIf IsFrame(FrmGrp, False) And FrmGrp.count > 0 ThenDebug.Print & " [Items]:" & FrmGrp.count & "----group"' 得到图框边界点坐标FrmGrp.Item(0).GetBoundingBox ptMin, ptMaxFor i = 1 To FrmGrp.count - 1FrmGrp.Item(i).GetBoundingBox TptMin, TptMaxReDim Preserve TptMin(0 To 1)ReDim Preserve TptMax(0 To 1)For j = 0 To 1If TptMin(j) < ptMin(j) ThenptMin(j) = TptMin(j)If TptMax(j) > ptMax(j) ThenptMax(j) = TptMax(j)End IfNext ji = i + 1Next' 将三维点转化为二维点坐标ReDim Preserve ptMin(0 To 1)ReDim Preserve ptMax(0 To 1)' 设置打印窗口ThisDrawing.ActiveLayout.SetWindowToPlot ptMin, ptMaxobjLayout.PlotType = acWindowIf Abs(ptMax(0) - ptMin(0)) < Abs(ptMax(1) - ptMin(1)) ThenIf AutoMedia Then objLayout.CanonicalMediaName = "A4"If AutoRotate Then objLayout.PlotRotation = ac0degreesEnd If' 完全预览并提示打印objPlot.DisplayPlotPreview acFullPreviewUserSel = MsgBox("是否打印预览?" & Chr(13) & Chr(13) & "打印到:" & objLayout.ConfigName & _" 大小:" & objLayout.CanonicalMediaName & " 方式:acWindow(" & objLayout.PlotType & ") " & _Chr(13) & Chr(13) & "选择[取消]退出程序!", vbYesNoCancel, "打印选项")If UserSel = vbYes ThenPlotCount = PlotCount + 1objPlot.PlotToDevice objLayout.ConfigNameElseIf UserSel = vbCancel ThenExit ForEnd IfEnd IfNext FrmGrp' 没有找到图框时按范围打印If PlotCount = 0 And objDoc.ModelSpace.count > 0 ThenptMax = ThisDrawing.GetVariable("EXTMAX")ptMin = ThisDrawing.GetVariable("EXTMIN")' 图形范围内无实体则退出If ptMax(0) = ptMin(0) Or ptMax(1) = ptMin(1) ThenExit Sub' 设置范围打印objLayout.PlotType = acExtents' 对纵向的图纸设置If Abs(ptMax(0) - ptMin(0)) < Abs(ptMax(1) - ptMin(1)) ThenIf AutoMedia Then objLayout.CanonicalMediaName = "A4"If AutoRotate Then objLayout.PlotRotation = ac0degreesEnd If' 完全预览并提示打印objPlot.DisplayPlotPreview acFullPreviewUserSel = MsgBox("是否打印预览?" & Chr(13) & Chr(13) & "打印到:" & objLayout.ConfigName & _" 大小:" & objLayout.CanonicalMediaName & " 方式:acExtents(" & objLayout.PlotType & ") " & _Chr(13) & Chr(13) & "选择[取消]退出程序!", vbYesNoCancel, "打印选项")If UserSel = vbYes ThenobjPlot.PlotToDevice objLayout.ConfigNameElseIf UserSel = vbCancel ThenExit SubEnd IfEnd If' 关闭文档False 为不保存修改If AutoClose Then objDoc.Close False, End SubPublic Function IsFrame(entobj As Object, AutoMode As Boolean) As Boolean '判断是否为图框On Error Resume NextIsFrame = FalseDim i As IntegerDim FrmNameList As VariantFrmNameList = "blkFrame,A1,A2,A3,A4,PC_PAPER_DIC"'图框块、编组名列表FrmNameList = Split(FrmNameList, ",")For i = 0 To UBound(FrmNameList)If = FrmNameList(i) ThenIsFrame = TrueExit ForEnd IfNext'块名不符时由大小比例判断是否为图框(可能会误判,不过几率不高)If IsFrame = False And AutoMode And entobj.ObjectName = "AcDbBlockReference"Then entobj.GetBoundingBox ptMin, ptMaxDebug.Print ptMin(0) & "--" & ptMax(0)If Abs((ptMax(1) - ptMin(1)) / (ptMax(0) - ptMin(0)) - 1.414) < 0.01 Or Abs((ptMax(1) - ptMin(1)) / (ptMax(0) - ptMin(0)) - 0.707) < 0.01 ThenIsFrame = TrueEnd IfEnd IfEnd Function。