自己用VBA编的批量打印程序（原创）

自己用VBA编的批量打印程序（原创）OptionExplicit'图形集合PrivatecolDwgsAsNewCollection'文档对象DimobjDocAsAcadDocument'布局对象DimobjLayoutAsAcadLayout'打印对象DimobjPlotAsAcadPlotPrivateTypeBrowseInfohOwnerAsLongpidlRootAsLongpszDisplayNameAsStringlpszTitleAsStringulFlagsAsLonglpfnAsLonglParamAsLongiImageAsLongEndTypePrivateConstMAX_PATH=260'代表ESC键PrivateConstVK_ESCAPE=&H1B'API函数的声明PrivateDeclareFunctionSHBrowseForFolderLib"shell32.dll"_Alias"SHBrowseForFolderA"(lpBrowseInfoAsBrowseInfo)AsLongPrivateDeclareFunctionFindWindowLib"user32"Alias"FindWindowA"(ByVallpClassNameAsString,_ByVallpWindowNameAsString)AsLongPrivateDeclareFunctionSHGetPathFromIDListLib"shell32.dll"Alias"SHGetPathFromIDListA"(ByVal_pidlAsLong,ByValpszPathAsString)AsLongPrivateDeclareFunctionGetAsyncKeyStateLib"user32"(ByValvKeyAsLong)AsInteger'功能：判断用户是否按下某一个键'输入：代表键的常量（从APIViewer中获得）'调用：API函数GetAsyncKeyState'返回：如果用户按下了指定的键，返回True；否则返回False'示例：'

IfCheckKey(&H1B)=TrueThendosthPrivateFunctionCheckKey(lngKeyAsLong)AsBooleanIfGetAsyncKeyState(lngKey)ThenCheckKey=TrueElseCheckKey=FalseEndIfEndFunctionPrivateSubcboPaperSize_Change()'若组合框非空IfcboPaperSize.Text<>""Then'设置图纸尺寸objLayout.CanonicalMediaName=cboPaperSize.Text'显示图纸尺寸CallSetPlotZoneEndIfEndSubPrivateSubcboPlotScale_Click()IfcboPlotScale.ValueThenobjLayout.UseStandardScale=True

'使用标准打印比例ElseobjLayout.UseStandardScale=False'使用自定义打印比例EndIfSelectCasecboPlotScale.ValueCase0'txtNumerator=1'txtDenominator=1Case1objLayout.StandardScale=acScaleToFittxtNumerator=1txtDenominator=""Case2objLayout.StandardScale=ac1_1txtNumerator=1txtDenominator=1Case3objLayout.StandardScale=ac1_2txtNumerator=1txtDenominator=2Case4objLayout.StandardScale=ac1_4txtNumerator=1txtDenominator=4Case5objLayout.StandardScale=ac1_8txtNumerator=1txtDenominator=8Case6objLayout.StandardScale=ac1_10txtNumerator=1txtDenominator=10Case7objLayout.StandardScale=ac1_16txtNumerator=1txtDenominator=16Case8objLayout.StandardScale=ac1_20txtNumerator=1txtDenominator=20Case9objLayout.StandardScale=ac1_30txtNumerator=1txtDenominator=30Case10objLayout.StandardScale=ac1_40txtNumerator=1txtDenominator=40Case11objLayout.StandardScale=ac1_50txtNumerator=1txtDenominator=50Case12objLayout.StandardScale=ac1_100txtNumerator=1txtDenominator=100Case13objLayout.StandardScale=ac2_1txtNumerator=2txtDenominator=1Case14objLayout.StandardScale=ac4_1txtNumerator=4txtDenominator=1Case15objLayout.StandardScale=ac8_1txtNumerator=8txtDenominator=1Case16objLayout.StandardScale=ac10_1txtNumerator=10txtDenominator=1Case17objLayout.StandardScale=ac100_1txtNumerator=100txtDenominator=1EndSelectEndSubPrivateSubcboPlotStyleTableNames_Change()'设置打印样式表objLayout.StyleSheet=cboPlotStyleTableNames.TextEndSubPrivateSubcboPrintersName_Change()OnErrorResumeNext'设置打印机配置（对应AutoCAD中：打印>打印设备>打印机配置>"DWF6ePlot.pc3"）objLayout.ConfigName=cboPrintersName.Text'更新显示AutoCAD中当前可用的所有图纸尺寸CallListPaperSize'更新显示AutoCAD中当前可用的所有打印样式表CallListPlotStyleTableNamesEndSubPrivateSubchkCenterPlot_Change()DimPtOffset(0To1)AsDouble'设置图纸是否居中打印IfchkCenterPlot.ValueThenPtOffset(0)=0PtOffset(1)=0ElsePtOffset(0)=-5PtOffset(1)=-5EndIftxtOffsetX.Value=PtOffset(0)txtOffsetY.Value=PtOffset(1)EndSubPrivateSubchkPlotHidden_Change()'设置是否隐藏图纸空间对象IfchkPlotHidden.ValueThen'打印时隐藏图纸空间对象objLayout.PlotHidden=TrueElse'打印时不隐藏图纸空间对象objLayout.PlotHidden=FalseEndIfEndSubPrivateSubchkPlotToFile_Change()'设置“打印到文件”组各控件激活状态IfchkPlotToFile.ValueThenlbPlotPath.Enabled=TruecboPlotPath.Enabled=TruecmdBrowse2.Enabled=TrueElselbPlotPath.Enabled=FalsecboPlotPath.Enabled=FalsecmdBrowse2.Enabled=FalseEndIfEndSubPrivateSubchkPlotWithLineweights_Change()'设置是否打印对象线宽IfchkPlotWithLineweights.ValueThen'打印时使用图形文件中的线宽objLayout.PlotWithLineweights=TrueElse'打印时使用打印样式中的线宽objLayout.PlotWithLineweights=FalseEndIfEndSubPrivateSubchkPlotWithPlotStyles_Change()'设置是否应用打印样式IfchkPlotWithPlotStyles.ValueThen'打印时在对象中使用打印样式objLayout.PlotWithPlotStyles=TruechkPlotWithLineweights.Enabled=FalseElse'打印时在对象中不使用打印样式objLayout.PlotWithPlotStyles=FalsechkPlotWithLineweights.Enabled=TrueEndIfEndSubPrivateSubchkReverse_Click()'设置图纸打印方向CallPaperRotationChangeEndSubPrivateSubcmdAdd_Click()'如果列表框中未存在任何元素IflstCurFiles.ListCount=0ThenMsgBox"请先向列表框中添加文件！",vbCriticalExitSubEndIfDimstrFliesAsStringDimiAsIntegerDimnAsIntegern=0'将上面列表框中选中的对象添加到下面的列表框中Fori=0TolstCurFiles.ListCount-1IflstCurFiles.Selected(i)ThenstrFlies=lstCurFiles.List(i)n=n+1IfNotHasItem(lstPlotFiles,strFlies)ThenlstPlotFiles.AddItemlstCurFiles.List(i)'EndIfEndIfNexti'如果列表框中未存在被选择的元素Ifn=0ThenMsgBox"请选择要从列表中添加的元素！",vbCriticalExitSubEndIfEndSubPrivateSubcmdAddAll_Click()'如果列表框中未存在任何元素IflstCurFiles.ListCount=0ThenMsgBox"请先向列表框中添加文件！",vbCriticalExitSubEndIfDimstrFliesAsStringDimiAsInteger'将上面列表框中选中的对象添加到下面的列表框中Fori=0TolstCurFiles.ListCount-1strFlies=lstCurFiles.List(i)IfNotHasItem(lstPlotFiles,strFlies)ThenlstPlotFiles.AddItemlstCurFiles.List(i)EndIfNextiEndSubPrivateSubcmdBrowse_Click()'在文本框中显示获得的路径txtCurPath.Text=ReturnFolder(0)EndSubPrivateSubcmdBrowse2_Click()DimstrPathAsStringstrPath=ReturnFolder(0)'若返回文件夹路径非空IfstrPath<>""Then'若组合框中未存在返回文件夹路径，则将其添加到组合框中IfHasItem2(strPath)<0Then'在组合框中显示获得的路径WithcboPlotPath.AddItemstrPath,0'使用下拉列表的形式.Style=fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn=0'设置默认的显示项目.ListIndex=0EndWith'若组合框中已存在返回文件夹路径，则将返回文件夹路径置为选中ElseWithcboPlotPath'设置默认的显示项目.ListIndex=HasItem2(strPath)EndWithEndIfEndIfEndSubPrivateSubcmdClear_Click()'如果列表框中未存在任何元素IflstPlotFiles.ListCount=0ThenMsgBox"请先向列表框中添加文件！",vbCriticalExitSubEndIfDimiAsInteger,nAsInteger,countAsInteger'列表框中元素的数量count=lstPlotFiles.ListCountn=0'将列表框中选中的对象删除Fori=0Tocount-1IflstPlotFiles.Selected(i)Thenn=n+1Else'移动列表框中的元素lstPlotFiles.List(i-n)=lstPlotFiles.List(i)EndIfNexti'如果列表框中未存在被选择的元素Ifn=0ThenMsgBox"请选择要从列表中清除的元素！",vbCriticalExitSubEndIf'删除最后n行的元素Fori=1TonlstPlotFiles.RemoveItem(count-i)NextiEndSubPrivateSubcmdClearAll_Click()'如果列表框中未存在任何元素IflstPlotFiles.ListCount=0ThenMsgBox"请先向列表框中添加文件！",vbCriticalExitSubEndIfDimMsg,Style,Title,Help,Ctxt,Response,MyStringMsg="清除整个图形列表?"Style=vbOKCancel+vbQuestion+vbDefaultButton2Title="ClearFiles"Response=MsgBox(Msg,Style,Title)IfResponse=vbOKThentxtCurPath.Text=""'清除列表框中所有元素lstPlotFiles.ClearEndIfEndSubPrivateSubcmdExit_Click()'退出EndEndSubPrivateSubcmdInput_Click()'导入打印设置'设置标准对话框WithcomDlg'设置标准对话框标题.DialogTitle="导入打印设置"'设置标准对话框类型列表中所显示的过滤器.Filter="文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"'设置标准对话框的起始目录'.InDir="C:\"'显示[打开]对话框.ShowOpenEndWithDimstrFileNameAsStringstrFileName=comDlg.fileName'strFileName="F:\AutoCAD\丹通施工图\打印设置.txt"'若返回文件名为空，不进行操作IfstrFileName=""ThenMsgBox"请重新选择文件位置！"ExitSubEndIf'读入文件的操作DimiAsInteger,nFileAsIntegerDimxAsDouble,yAsDoubleDimcountAsInteger,indexAsIntegerDimstrTempAsString'获得下一个可供Open语句使用的文件号nFile=FreeFile'打开文件OpenstrFileNameForInputAs#nFile'读入当前路径'读入一行文本并存储在变量中LineInput#nFile,strTemp'读入当前路径并设置文本框文字Input#nFile,strTemptxtCurPath.Text=strTemp'读入打印文件列表并添加到列表框中CallInputData3(lstPlotFiles,nFile)'读入打印机配置列表并添加到组合框中CallInputData(cboPrintersName,nFile)'读入打印样式表并添加到组合框中CallInputData(cboPlotStyleTableNames,nFile)'读入图纸尺寸列表并添加到组合框中CallInputData(cboPaperSize,nFile)'读入图纸单位并设置单选按钮选择状态'读入一行文本并存储在变量中LineInput#nFile,strTemp'读入图纸单位Input#nFile,strTemp'设置单选按钮选择状态IfstrTemp="毫米"ThenoptMillimeters.Value=TrueElseoptInches.Value=TrueEndIf'读入图纸方向并设置单选按钮选择状态'读入一行文本并存储在变量中LineInput#nFile,strTemp'读入图纸方向Input#nFile,strTemp'设置单选按钮选择状态IfstrTemp="纵向"ThenoptVertical.Value=TrueElseoptHorizontal.Value=TrueEndIf'读入是否反向打印并设置复选按钮选择状态CallInputData2(chkReverse,nFile)'读入打印份数'读入一行文本并存储在变量中LineInput#nFile,strTemp'读入打印份数Input#nFile,count'设置文本框文字txtNumber.Text=count'读入是否打印到文件并设置复选按钮选择状态CallInputData2(chkPlotToFile,nFile)'读入打印路径列表并添加到组合框中CallInputData(cboPlotPath,nFile)'读入打印比例列表并添加到组合框中CallInputData(cboPlotScale,nFile)'读入一行文本并存储在变量中LineInput#nFile,strTemp'读入当前打印比例并设置文本框文字Input#nFile,xInput#nFile,ytxtNumerator.Text=xtxtDenominator.Text=y'读入是否居中打印并设置复选按钮选择状态CallInputData2(chkCenterPlot,nFile)'读入打印偏移'读入一行文本并存储在变量中LineInput#nFile,strTemp'读入打印偏移并设置文本框文字Input#nFile,xInput#nFile,ytxtOffsetX.Text=xtxtOffsetY.Text=y'读入是否打印对象线宽并设置复选按钮选择状态CallInputData2(chkPlotWithLineweights,nFile)'读入是否采用打印样式并设置复选按钮选择状态CallInputData2(chkPlotWithPlotStyles,nFile)'读入是否隐藏图纸空间对象并设置复选按钮选择状态CallInputData2(chkPlotHidden,nFile)'读入图框形式并设置单选按钮选择状态'读入一行文本并存储在变量中LineInput#nFile,strTemp'读入图框形式Input#nFile,strTemp'设置单选按钮选择状态IfstrTemp="图块"ThenoptBlock.Value=TrueElseoptLayer.Value=TrueEndIf'读入图块名列表并添加到组合框中CallInputData(cboBlockName,nFile)'读入图层名列表并添加到组合框中CallInputData(cboLayerName,nFile)'关闭文件Close#nFileEndSubPrivateSubcmdListPrints_Click()'显示AutoCAD中当前可用的打印机列表CallListPrintersEndSubPrivateSubcmdOutput_Click()'导出打印设置'设置标准对话框WithcomDlg'设置标准对话框标题.DialogTitle="导出打印设置"'设置标准对话框类型列表中所显示的过滤器.Filter="文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"'设置标准对话框的起始目录'.InDir="C:\"'设置[另存为]对话框的缺省扩展名.DefaultExt="txt"'显示[另存为]对话框.ShowSaveEndWithDimstrFileNameAsString,strTempAsStringstrFileName=comDlg.fileName'strFileName="F:\AutoCAD\丹通施工图\打印设置.txt"'若返回文件名为空，不进行操作IfstrFileName=""ThenMsgBox"请重新选择保存位置！"ExitSubEndIf'保存文件的操作DimiAsInteger'打开文件OpenstrFileNameForOutputAs#1'输出当前路径Print#1,"当前路径："Print#1,txtCurPath.Text'输出打印文件列表Print#1,"打印文件列表："'输出打印机配置列表的信息CallOutputData3(lstPlotFiles,1)'输出打印机配置Print#1,"打印机配置："'输出打印机配置列表的信息CallOutputData(cboPrintersName,1)'输出打印样式表Print#1,"打印样式表："'输出打印样式表的信息CallOutputData(cboPlotStyleTableNames,1)'输出图纸尺寸列表Print#1,"图纸尺寸列表："'输出图纸尺寸列表的信息CallOutputData(cboPaperSize,1)'输出图纸单位Print#1,"图纸单位："'输出图纸单位信息IfoptMillimeters.Value=TrueThenstrTemp="毫米"ElsestrTemp="英寸"EndIfPrint#1,strTemp'输出图纸方向Print#1,"图纸方向："'输出图纸方向信息IfoptVertical.Value=TrueThenstrTemp="纵向"ElsestrTemp="横向"EndIfPrint#1,strTemp'输出是否反向打印Print#1,"是否反向打印："CallOutputData2(chkReverse,1)'输出打印份数Print#1,"打印份数："Print#1,txtNumber.Text'输出是否打印到文件Print#1,"是否打印到文件："CallOutputData2(chkPlotToFile,1)'输出打印路径Print#1,"打印路径："'输出打印路径列表的信息CallOutputData(cboPlotPath,1)'输出打印比例Print#1,"打印比例："'输出打印比例列表的信息CallOutputData(cboPlotScale,1)'输出当前打印比例Print#1,"当前打印比例："Print#1,txtNumerator.TextPrint#1,txtDenominator.Text'输出是否居中打印Print#1,"是否居中打印："CallOutputData2(chkCenterPlot,1)'输出打印偏移Print#1,"打印偏移："Print#1,txtOffsetX.TextPrint#1,txtOffsetY.Text'输出是否打印对象线宽Print#1,"是否打印对象线宽："CallOutputData2(chkPlotWithLineweights,1)'输出是否采用打印样式Print#1,"是否采用打印样式："CallOutputData2(chkPlotWithPlotStyles,1)'输出是否隐藏图纸空间对象Print#1,"是否隐藏图纸空间对象："CallOutputData2(chkPlotHidden,1)'输出图框形式Print#1,"图框形式："'输出图框形式信息IfoptBlock.Value=TrueThenstrTemp="图块"ElsestrTemp="图层"EndIfPrint#1,strTemp'输出图块名列表Print#1,"图块名列表："'输出图块名列表的信息CallOutputData(cboBlockName,1)'输出图层名列表Print#1,"图块名列表："'输出图层名列表的信息CallOutputData(cboLayerName,1)'关闭文件Close1EndSubPrivateSubcmdPick_Click()OnErrorResumeNextDimobjSelectAsAcadEntityDimptPickAsVariantDimstrTempAsStringSetobjDoc=ThisDrawing.Application.ActiveDocument'将控制权交给AutoCADfrmBatchPlot.Hide'在AutoCAD中选择实体并判断类型Retry:objDoc.Utility.GetEntityobjSelect,ptPick,vbCrLf&"请选择实体："'处理按下Esc键的错误IfobjSelectIsNothingThenIfCheckKey(VK_ESCAPE)=TrueThen'显示对话框frmBatchPlot.ShowExitSubElseGoToRetryEndIfEndIf'处理未选择到实体的错误IfErr<>0ThenErr.ClearGoToRetryEndIf'若为指定图块IfoptBlock.Value=TrueThen'判断实体是否块参照IfTypeOfobjSelectIsAcadBlockReferenceThen'判断实体是否模型空间、图纸空间和匿名块IfStrComp(Left(objSelect.Name,1),"*")<>0Then'获得块参照名strTemp=objSelect.NameElseMsgBox"您选择的是匿名块，请重新选择块参照！",vbCritical'显示对话框frmBatchPlot.ShowExitSubEndIfElseMsgBox"您选择的不是块参照，请重新选择块参照！",vbCritical'显示对话框frmBatchPlot.ShowExitSubEndIf'刷新块参照列表CallListBlock'将所选块参照在组合框中置为当前CallSetSelected(cboBlockName,strTemp)Else'判断实体是否多段线IfTypeOfobjSelectIsAcadLWPolylineThen'获得多段线所在图层名strTemp=objSelect.LayerElseMsgBox"您选择的不是轻量多段线，请重新选择轻量多段线！",vbCritical'显示对话框frmBatchPlot.ShowExitSubEndIf'刷新图层列表CallListLayer'将所选实体所在图层在组合框中置为当前CallSetSelected(cboLayerName,strTemp)EndIf'显示对话框frmBatchPlot.ShowEndSubPrivateSubSetSelected(ListObjectAsObject,SItemAsString)'将该元素在组合框中置为当前DimiAsLong'通过比较确定该元素的位置Fori=0To(ListObject.ListCount-1)IfStrComp(ListObject.List(i),SItem,vbTextCompare)=0ThenListObject.ListIndex=iExitSubEndIfNextEndSubPrivateSubcmdPreview_Click()'若按图块进行批量打印IfoptBlock.Value=TrueThenIfcboBlockName.ListCount=0OrcboBlockName.Text=""ThenMsgBox"请先选择块参照！",vbCriticalExitSubEndIfCallPreviewByBlock(cboBlockName.Text)'若按图层进行批量打印ElseIfcboLayerName.ListCount=0OrcboLayerName.Text=""ThenMsgBox"请先选择块参照！",vbCriticalExitSubEndIfCallPreviewByLayer(cboLayerName.Text)EndIfEndSubPrivateSubcmdRefresh_Click()'刷新块参照列表CallListBlock'刷新图层列表CallListLayerEndSubPrivateSubcmdPlot_Click()'若按图块进行批量打印IfoptBlock.Value=TrueThenIfcboBlockName.ListCount=0OrcboBlockName.Text=""ThenMsgBox"请先选择块参照！",vbCriticalExitSubEndIfCallBatchPlotByBlock(cboBlockName.Text)'若按图层进行批量打印ElseIfcboLayerName.ListCount=0OrcboLayerName.Text=""ThenMsgBox"请先选择块参照！",vbCriticalExitSubEndIfCallBatchPlotByLayer(cboLayerName.Text)EndIfEndSubPrivateSubcmdAbout_Click()'显示关于对话框frmAbout.ShowEndSubPrivateSuboptBlock_Change()'设置“图块与图层”组各控件激活状态IfoptBlock.Value=TrueThenlbBlockName.Enabled=TruecboBlockName.Enabled=TruelbLayerName.Enabled=FalsecboLayerName.Enabled=FalseElselbBlockName.Enabled=FalsecboBlockName.Enabled=FalselbLayerName.Enabled=TruecboLayerName.Enabled=TrueEndIfEndSubPrivateSuboptLayer_Change()'设置“图块与图层”组各控件激活状态IfoptBlock.Value=TrueThenlbBlockName.Enabled=TruecboBlockName.Enabled=TruelbLayerName.Enabled=FalsecboLayerName.Enabled=FalseElselbBlockName.Enabled=FalsecboBlockName.Enabled=FalselbLayerName.Enabled=TruecboLayerName.Enabled=TrueEndIfEndSubPrivateSuboptMillimeters_Change()'设置图纸单位IfoptMillimeters.Value=TrueThenobjLayout.PaperUnits=acMillimeterslbUnit.Caption="毫米＝"lbUnitX.Caption="毫米"lbUnitY.Caption="毫米"lbPaperUnit.Caption="毫米"ElseobjLayout.PaperUnits=acIncheslbUnit.Caption="英寸＝"lbUnitX.Caption="英寸"lbUnitY.Caption="英寸"lbPaperUnit.Caption="英寸"EndIf'显示图纸尺寸CallSetPlotZoneEndSubPrivateSubOptVertical_Change()'设置图纸打印方向CallPaperRotationChangeEndSubPrivateSubspnAngle_SpinDown()IfCInt(txtNumber.Text)>1ThentxtNumber.Text=CInt(txtNumber.Text)-1EndIfEndSubPrivateSubspnAngle_SpinUp()txtNumber.Text=CInt(txtNumber.Text)+1EndSubPrivateSubtxtCurPath_Change()'查找文件，向列表框中添加IfLen(Dir(txtCurPath.Text))>0ThenFindFilecolDwgs,txtCurPath.Text,"dwg"IfAddToList(lstCurFiles,colDwgs)ThenEndIfEndIfEndSubPrivateSubtxtDenominator_KeyPress(ByValKeyAsciiAsMSForms.ReturnInteger)'设置自定义图纸尺寸IfIsNumeric(txtDenominator)Then'设置组合框显示项目为“自定义”cboPlotScale.ListIndex=0ElseMsgBox"请输入数字！",vbCriticalEndIfEndSubPrivateSubtxtNumber_Change()'设置图纸打印份数'objPlot.NumberOfCopies=CDbl(txtNumber.Text)'objPlot.NumberOfCopies=CInt(txtNumber.Text)objPlot.NumberOfCopies=txtNumber.ValueEndSubPrivateSubtxtNumerator_KeyPress(ByValKeyAsciiAsMSForms.ReturnInteger)'设置自定义图纸尺寸IfIsNumeric(txtNumerator)Then'设置组合框显示项目为“自定义”cboPlotScale.ListIndex=0ElseMsgBox"请输入数字！",vbCriticalEndIfEndSubPrivateSubtxtOffsetX_KeyPress(ByValKeyAsciiAsMSForms.ReturnInteger)'设置自定义图纸尺寸If(KeyAscii>=Asc("0")AndKeyAscii<=Asc("9"))OrKeyAscii=Asc(".")OrKeyAscii=Asc("-")Then'取消“居中打印”复选框chkCenterPlot.Value=FalseElseMsgBox"请输入数字！",vbCriticalEndIfEndSubPrivateSubtxtOffsetY_KeyPress(ByValKeyAsciiAsMSForms.ReturnInteger)'设置自定义图纸尺寸If(KeyAscii>=Asc("0")AndKeyAscii<=Asc("9"))OrKeyAscii=Asc(".")OrKeyAscii=Asc("-")Then'取消“居中打印”复选框chkCenterPlot.Value=FalseElseMsgBox"请输入数字！",vbCriticalEndIfEndSubPrivateSubUserForm_Initialize()SetobjDoc=ThisDrawing.Application.ActiveDocumentSetobjLayout=ThisDrawing.ActiveLayoutSetobjPlot=ThisDrawing.Plot'禁用“当前路径”文本框txtCurPath.Enabled=False'列出当前所有打印机CallListPrinters'显示AutoCAD中当前可用的打印比例列表CallListPlotScale'设置“打印到文件”是否选中chkPlotToFile.Value=False'禁用“打印到文件”组各控件lbPlotPath.Enabled=FalsecboPlotPath.Enabled=FalsecmdBrowse2.Enabled=False'显示AutoCAD中当前可用的图块CallListBlock'显示AutoCAD中当前可用的图层CallListLayerEndSubPublicFunctionReturnFolder(lngHwndAsLong)AsStringDimBrowserAsBrowseInfoDimlngFolderAsLongDimstrPathAsStringDimstrTempAsStringWithBrowser.hOwner=lngHwnd.lpszTitle="选择工作路径".pszDisplayName=String(MAX_PATH,0)EndWith'用空格填充字符串strPath=String(MAX_PATH,0)'调用API函数显示文件夹列表lngFolder=SHBrowseForFolder(Browser)'使用API函数获取返回的路径IflngFolderThenSHGetPathFromIDListlngFolder,strPathstrTemp=Left(strPath,InStr(strPath,vbNullChar)-1)If(Right(strTemp,1)<>"\")ThenstrTemp=strTemp&"\"EndIfReturnFolder=strTempEndIfEndFunctionPublicSubFindFile(ByReffilesAsCollection,strDir,strExt)'删除集合中所有的对象DimiAsIntegerFori=1Tofiles.countfiles.Remove1Nexti'查找dwg文件，并将其添加到集合中DimstrFileNameAsStringIf(Right(strDir,1)<>"\")ThenstrDir=strDir&"\"EndIfstrFileName=Dir(strDir&"*.*",vbDirectory)DoWhile(strFileName<>"")If(UCase(Right(strFileName,3))=UCase(strExt))Thenfiles.AddstrDir&strFileNameEndIfstrFileName=Dir

'返回下一个符合条件的文件LoopEndSubPublicFunctionAddToList(objBoxAsListBox,NamesAsCollection)AsBooleanDimiAsIntegerOnErrorGoToError_ControlobjBox.Clear'将集合中的对象添加到列表框中Fori=1ToNames.countobjBox.AddItemNames(i)NextiExit_Here:AddToList=TrueExitFunctionError_Control:MsgBox"发生下面的错误："&Err.NumberAddToList=FalseEndFunctionPrivateFunctionHasItem(objBoxAsListBox,strFliesAsString)AsBoolean'检查路径是否已经存在HasItem=FalseDimiAsIntegerIfobjBox.ListCount>0ThenFori=0ToobjBox.ListCount-1IfStrComp(objBox.List(i),strFlies,vbTextCompare)=0ThenHasItem=TrueExitFunctionEndIfNextiEndIfEndFunctionPrivateFunctionHasItem2(ByValstrPathAsString)AsInteger'检查路径是否已经存在HasItem2=-1DimiAsIntegerIfcboPlotPath.ListCount>0ThenFori=0TocboPlotPath.ListCount-1IfStrComp(cboPlotPath.List(i),strPath,vbTextCompare)=0ThenHasItem2=iExitFunctionEndIfNextiEndIfEndFunction'打开或激活文件PrivateSubOpenFile(fileNameAsString)DimdwgFile

AsAcadDocumentDimstrFile

AsStringForEachdwgFileInThisDrawing.Application.DocumentsstrFile=dwgFile.Path&"\"&dwgFile.Name'若第i个图形文件已经被打开，则将其激活IfstrFile=fileNameThen'若dwgFile尚未激活，则将其激活IfdwgFile.Active=FalseThenThisDrawing.Application.ActiveDocument=dwgFileEndIfExitSubEndIfNext'若第i个图形文件尚未被打开，则将其打开ThisDrawing.Application.Documents.OpenfileNameEndSub'显示AutoCAD中当前可用的打印机列表PublicSubListPrinters()objLayout.RefreshPlotDeviceInfo'获得所有的可用打印机DimplotDevices

AsVariantplotDevices=objLayout.GetPlotDeviceNames'删除以前的打印机列表cboPrintersName.Clear'显示打印机列表DimiAsIntegerFori=0ToUBound(plotDevices)cboPrintersName.AddItem(plotDevices(i))Nexti'设置组合框初始选项WithcboPrintersName'使用下拉列表的形式.Style=fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn=0'设置默认的显示项目.ListIndex=1EndWithEndSub'显示AutoCAD中当前可用的打印样式PublicSubListPlotStyleTableNames()SetobjLayout=ThisDrawing.ActiveLayoutobjLayout.RefreshPlotDeviceInfo'获得所有的可用打印样式DimplotStyleTables

AsVariantplotStyleTables=objLayout.GetPlotStyleTableNames'删除以前的打印样式列表cboPlotStyleTableNames.Clear'显打印样式列表DimiAsIntegerFori=0ToUBound(plotStyleTables)cboPlotStyleTableNames.AddItem(plotStyleTables(i))Nexti'设置组合框初始选项WithcboPlotStyleTableNames'使用下拉列表的形式.Style=fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn=0'设置默认的显示项目.ListIndex=0EndWithEndSub'显示AutoCAD中当前可用的图纸尺寸PublicSubListPaperSize()objLayout.RefreshPlotDeviceInfo'获得所有当前可用可用图纸尺寸列表DimpaperSizes

AsVariantpaperSizes=objLayout.GetCanonicalMediaNames'删除以前的图纸尺寸列表cboPaperSize.Clear'显示图纸尺寸列表DimiAsIntegerFori=0ToUBound(paperSizes)cboPaperSize.AddItem(paperSizes(i))Nexti'设置组合框初始选项WithcboPaperSize'使用下拉列表的形式.Style=fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn=0'设置默认的显示项目.ListIndex=0EndWithEndSub'显示AutoCAD中可以使用的打印比例PublicSubListPlotScale()'显打印比例列表WithcboPlotScale.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=2EndWithtxtNumerator=1txtDenominator=1EndSub'显示AutoCAD中当前可用的图层PublicSubListLayer()DimLayerListAsCollection'获得图形中存在的图层列表SetLayerList=GetLayerList()'刷新图层列表CallRefreshList(cboLayerName,LayerList)'选择图层列表中的第一个实体IfcboLayerName.ListIndex=-1ThencboLayerName.ListIndex=0EndIfEndSub'获得图形中存在的图层列表PrivateFunctionGetLayerList()AsCollectionDimobjLayerAsAcadLayerDimLayerListAsNewCollectionSetobjDoc=ThisDrawing.Application.ActiveDocument'获得可用的图层ForEachobjLayerInobjDoc.LayersLayerList.AddobjLayer.Name,objLayer.NameNext'返回图形中块参照的列表SetGetLayerList=LayerListEndFunction'显示AutoCAD中当前可用的图块PublicSubListBlock()DimBlockReferenceListAsCollection'获得图形中存在的块参照列表SetBlockReferenceList=GetBlockReferences()'判断是否存在块参照IfBlockReferenceListIsNothingThenMsgBox"当前图形中不存在任何的块！",vbExclamationExitSubEndIf'刷新块参照列表CallRefreshList(cboBlockName,BlockReferenceList)'选择块参照列表中的第一个实体IfcboBlockName.ListIndex=-1ThencboBlockName.ListIndex=0EndIfEndSub'获得图形中存在的块参照列表PrivateFunctionGetBlockReferences()AsCollectionDimBlockListAsNewCollectionDimAcadObjectAsAcadEntitySetobjDoc=ThisDrawing.Application.ActiveDocument'获得可用的块参照ForEachAcadObjectInobjDoc.ModelSpaceIfAcadObject.ObjectName="AcDbBlockReference"Then'不将模型空间、图纸空间和匿名块添加到组合框中IfStrComp(Left(AcadObject.Name,1),"*")<>0ThenOnErrorResumeNextBlockList.AddAcadObject.Name,AcadObject.NameEndIfEndIfNext'返回图形中块参照的列表IfBlockList.count>0ThenSetGetBlockReferences=BlockListElseSetGetBlockReferences=NothingEndIfEndFunction'将组合对象中的元素写入列表框或组合框中PrivateSubRefreshList(ByRefListObjectAsObject,ByRefBlockListAsCollection)DimiAsLong'清空列表框ListObject.Clear'向列表框中添加新的元素Fori=1ToBlockList.countAddSortedListObject,BlockList(i)NextEndSubPrivateSubAddSorted(ListObjectAsObject,SItemAsString)'将元素添加到组合框或列表框中，并且排序DimiAsLong'元素数目小于1，不进行排序IfListObject.ListCount=0ThenListObject.AddItemSItemExitSubEndIf'通过比较确定该元素的位置，类似于插入排序法Fori=0To(ListObject.ListCount-1)IfStrComp(ListObject.List(i),SItem,vbTextCompare)=1ThenListObject.AddItemSItem,iExitSubEndIfNext'添加到列表框的最后ListObject.AddItemSItemEndSubPublicSubPaperRotationChange()'设置图纸打印方向IfoptVertical.Value=TrueThenIfchkReverse.Value=FalseThenobjLayout.PlotRotation=ac0degreesElseobjLayout.PlotRotation=ac180degreesEndIfElseIfchkReverse.Value=FalseThenobjLayout.PlotRotation=ac90degreesElseobjLayout.PlotRotation=ac270degreesEndIfEndIf'显示图纸大小CallSetPlotZoneEndSub'设置图纸可打印区域大小PublicSubSetPlotZone()DimWidthAsDouble,HeightAsDouble,tAsDouble'获得图纸大小objLayout.GetPaperSizeWidth,Height'图形方向为“横向”时宽高互调IfoptVertical.Value=FalseThent=WidthWidth=HeightHeight=tEndIf'单位由“毫米”转换为“英寸”IfoptMillimeters.Value=FalseThenWidth=Width/25.393Height=Height/25.393EndIf'显示图纸大小lbPaperSize.Caption=Round(Width,2)&"×"&Round(Height,2)EndSubPrivateSubOutputData(objBoxAsComboBox,nFileAsInteger)DimiAsInteger,countAsInteger,indexAsInteger'获得组合框列表数目count=objBox.ListCount'获得组合框当前选项的的索引号index=objBox.ListIndex'输出组合框列表数目Write#nFile,count'输出组合框当前选项的的索引号Write#nFile,index'输出所有的组合框选项Fori=0Tocount-1Print#nFile,objBox.List(i)NextEndSubPrivateSubOutputData2(objBoxAsCheckBox,nFileAsInteger)DimstrTempAsString'输出复选框选中状态IfobjBox.Value=TrueThenstrTemp="是"ElsestrTemp="否"EndIfPrint#nFile,strTempEndSubPrivateSubOutputData3(objBoxAsListBox,nFileAsInteger)DimiAsInteger,countAsInteger,indexAsInteger'获得列表框列表数目count=objBox.ListCount'获得列表框当前选项的的索引号index=objBox.ListIndex'输出列表框列表数目Write#nFile,count'输出列表框当前选项的的索引号Write#nFile,index'输出所有的列表框选项Fori=0Tocount-1Print#nFile,objBox.List(i)NextEndSubPrivateSubInputData(objBoxAsComboBox,nFileAsInteger)DimiAsInteger,countAsInteger,indexAsIntegerDimstrTempAsString'读入一行文本并存储在变量中LineInput#nFile,strTemp'读入组合框列表数目Input#nFile,count'读入组合框当前元素的的索引号Input#nFile,index'清空组合框所有元素objBox.Clear'读入组合框元素Fori=0Tocount-1LineInput#nFile,strTemp'将读入的列表添加到组合框中objBox.AddItemstrTempNext'设置组合框初始选项WithobjBox'使用下拉列表的形式.Style=fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn=0'设置默认的显示项目.ListIndex=indexEndWithEndSubPrivateSubInputData2(objBoxAsCheckBox,nFileAsInteger)DimstrTempAsString'读入一行文本并存储在变量中LineInput#nFile,strTemp'读入复选框选中状态Input#nFile,strTemp'设置复选按钮选择状态IfstrTemp="是"ThenobjBox.Value=TrueElseobjBox.Value=FalseEndIfEndSubPrivateSubInputData3(objBoxAsListBox,nFileAsInteger)DimiAsInteger,countAsInteger,indexAsIntegerDimstrTempAsString'读入一行文本并存储在变量中LineInput#nFile,strTemp'读入列表框列表数目Input#nFile,count'读入列表框当前元素的的索引号Input#nFile,index'清空列表框所有元素objBox.Clear'读入列表框元素Fori=0Tocount-1LineInput#nFile,strTemp'将读入的列表添加到列表框中objBox.AddItemstrTempNext'设置组合框初始选项WithobjBox'设置下拉列表的下标下限.BoundColumn=0'设置默认的显示项目.ListIndex=indexEndWithEndSubPublicSubSetPrinter()'设置打印机配置objLayout.ConfigName=cboPrintersName.Text'设置打印样式表objLayout.StyleSheet=cboPlotStyleTableNames.Text'设置图纸尺寸objLayout.CanonicalMediaName=cboPaperSize.Text'设置图纸单位IfoptMillimeters.Value=TrueThenobjLayout.PaperUnits=acMillimetersElseobjLayout.PaperUnits=acInchesEndIf'设置图纸打印方向IfoptVertical.Value=TrueThenIfchkReverse.Value=FalseThenobjLayout.PlotRotation=ac0degreesElseobjLayout.PlotRotation=ac180degreesEndIfElseIfchkReverse.Value=FalseThenobjLayout.PlotRotation=ac90degreesElseobjLayout.PlotRotation=ac270degreesEndIfEndIf'设置图纸打印比例IfcboPlotScale.ValueThenobjLayout.UseStandardScale=True

'使用标准打印比例ElseobjLayout.UseStandardScale=False'使用自定义打印比例EndIfSelectCasecboPlotScale.ValueCase0'设置自定义打印比例objLayout.SetCustomScaletxtNumerator.Value,txtDenominator.ValueCase1objLayout.StandardScale=acScaleToFitCase2objLayout.StandardScale=ac1_1Case3objLayout.StandardScale=ac1_2Case4objLayout.StandardScale=ac1_4Case5objLayout.StandardScale=ac1_8Case6objLayout.StandardScale=ac1_10Case7objLayout.StandardScale=ac1_16Case8objLayout.StandardScale=ac1_20Case9objLayout.StandardScale=ac1_30Case10objLayout.Stand