自己用VBA編的批量打印程序（原創(chuàng)）

自己用VBA編的批量打印程序（原創(chuàng)）OptionExplicit'圖形集合PrivatecolDwgsAsNewCollection'文檔對象DimobjDocAsAcadDocument'布局對象DimobjLayoutAsAcadLayout'打印對象DimobjPlotAsAcadPlotPrivateTypeBrowseInfohOwnerAsLongpidlRootAsLongpszDisplayNameAsStringlpszTitleAsStringulFlagsAsLonglpfnAsLonglParamAsLongiImageAsLongEndTypePrivateConstMAX_PATH=260'代表ESC鍵PrivateConstVK_ESCAPE=&H1B'API函數(shù)的聲明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中獲得）'調(diào)用：API函數(shù)GetAsyncKeyState'返回：如果用戶按下了指定的鍵，返回True；否則返回False'示例：'

IfCheckKey(&H1B)=TrueThendosthPrivateFunctionCheckKey(lngKeyAsLong)AsBooleanIfGetAsyncKeyState(lngKey)ThenCheckKey=TrueElseCheckKey=FalseEndIfEndFunctionPrivateSubcboPaperSize_Change()'若組合框非空IfcboPaperSize.Text<>""Then'設(shè)置圖紙尺寸objLayout.CanonicalMediaName=cboPaperSize.Text'顯示圖紙尺寸CallSetPlotZoneEndIfEndSubPrivateSubcboPlotScale_Click()IfcboPlotScale.ValueThenobjLayout.UseStandardScale=True

'使用標(biāo)準(zhǔn)打印比例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()'設(shè)置打印樣式表objLayout.StyleSheet=cboPlotStyleTableNames.TextEndSubPrivateSubcboPrintersName_Change()OnErrorResumeNext'設(shè)置打印機(jī)配置（對應(yīng)AutoCAD中：打印>打印設(shè)備>打印機(jī)配置>"DWF6ePlot.pc3"）objLayout.ConfigName=cboPrintersName.Text'更新顯示AutoCAD中當(dāng)前可用的所有圖紙尺寸CallListPaperSize'更新顯示AutoCAD中當(dāng)前可用的所有打印樣式表CallListPlotStyleTableNamesEndSubPrivateSubchkCenterPlot_Change()DimPtOffset(0To1)AsDouble'設(shè)置圖紙是否居中打印IfchkCenterPlot.ValueThenPtOffset(0)=0PtOffset(1)=0ElsePtOffset(0)=-5PtOffset(1)=-5EndIftxtOffsetX.Value=PtOffset(0)txtOffsetY.Value=PtOffset(1)EndSubPrivateSubchkPlotHidden_Change()'設(shè)置是否隱藏圖紙空間對象IfchkPlotHidden.ValueThen'打印時隱藏圖紙空間對象objLayout.PlotHidden=TrueElse'打印時不隱藏圖紙空間對象objLayout.PlotHidden=FalseEndIfEndSubPrivateSubchkPlotToFile_Change()'設(shè)置“打印到文件”組各控件激活狀態(tài)IfchkPlotToFile.ValueThenlbPlotPath.Enabled=TruecboPlotPath.Enabled=TruecmdBrowse2.Enabled=TrueElselbPlotPath.Enabled=FalsecboPlotPath.Enabled=FalsecmdBrowse2.Enabled=FalseEndIfEndSubPrivateSubchkPlotWithLineweights_Change()'設(shè)置是否打印對象線寬IfchkPlotWithLineweights.ValueThen'打印時使用圖形文件中的線寬objLayout.PlotWithLineweights=TrueElse'打印時使用打印樣式中的線寬objLayout.PlotWithLineweights=FalseEndIfEndSubPrivateSubchkPlotWithPlotStyles_Change()'設(shè)置是否應(yīng)用打印樣式IfchkPlotWithPlotStyles.ValueThen'打印時在對象中使用打印樣式objLayout.PlotWithPlotStyles=TruechkPlotWithLineweights.Enabled=FalseElse'打印時在對象中不使用打印樣式objLayout.PlotWithPlotStyles=FalsechkPlotWithLineweights.Enabled=TrueEndIfEndSubPrivateSubchkReverse_Click()'設(shè)置圖紙打印方向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'設(shè)置下拉列表的下標(biāo)下限.BoundColumn=0'設(shè)置默認(rèn)的顯示項(xiàng)目.ListIndex=0EndWith'若組合框中已存在返回文件夾路徑，則將返回文件夾路徑置為選中ElseWithcboPlotPath'設(shè)置默認(rèn)的顯示項(xiàng)目.ListIndex=HasItem2(strPath)EndWithEndIfEndIfEndSubPrivateSubcmdClear_Click()'如果列表框中未存在任何元素IflstPlotFiles.ListCount=0ThenMsgBox"請先向列表框中添加文件！",vbCriticalExitSubEndIfDimiAsInteger,nAsInteger,countAsInteger'列表框中元素的數(shù)量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()'導(dǎo)入打印設(shè)置'設(shè)置標(biāo)準(zhǔn)對話框WithcomDlg'設(shè)置標(biāo)準(zhǔn)對話框標(biāo)題.DialogTitle="導(dǎo)入打印設(shè)置"'設(shè)置標(biāo)準(zhǔn)對話框類型列表中所顯示的過濾器.Filter="文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"'設(shè)置標(biāo)準(zhǔn)對話框的起始目錄'.InDir="C:\"'顯示[打開]對話框.ShowOpenEndWithDimstrFileNameAsStringstrFileName=comDlg.fileName'strFileName="F:\AutoCAD\丹通施工圖\打印設(shè)置.txt"'若返回文件名為空，不進(jìn)行操作IfstrFileName=""ThenMsgBox"請重新選擇文件位置！"ExitSubEndIf'讀入文件的操作DimiAsInteger,nFileAsIntegerDimxAsDouble,yAsDoubleDimcountAsInteger,indexAsIntegerDimstrTempAsString'獲得下一個可供Open語句使用的文件號nFile=FreeFile'打開文件OpenstrFileNameForInputAs#nFile'讀入當(dāng)前路徑'讀入一行文本并存儲在變量中LineInput#nFile,strTemp'讀入當(dāng)前路徑并設(shè)置文本框文字Input#nFile,strTemptxtCurPath.Text=strTemp'讀入打印文件列表并添加到列表框中CallInputData3(lstPlotFiles,nFile)'讀入打印機(jī)配置列表并添加到組合框中CallInputData(cboPrintersName,nFile)'讀入打印樣式表并添加到組合框中CallInputData(cboPlotStyleTableNames,nFile)'讀入圖紙尺寸列表并添加到組合框中CallInputData(cboPaperSize,nFile)'讀入圖紙單位并設(shè)置單選按鈕選擇狀態(tài)'讀入一行文本并存儲在變量中LineInput#nFile,strTemp'讀入圖紙單位Input#nFile,strTemp'設(shè)置單選按鈕選擇狀態(tài)IfstrTemp="毫米"ThenoptMillimeters.Value=TrueElseoptInches.Value=TrueEndIf'讀入圖紙方向并設(shè)置單選按鈕選擇狀態(tài)'讀入一行文本并存儲在變量中LineInput#nFile,strTemp'讀入圖紙方向Input#nFile,strTemp'設(shè)置單選按鈕選擇狀態(tài)IfstrTemp="縱向"ThenoptVertical.Value=TrueElseoptHorizontal.Value=TrueEndIf'讀入是否反向打印并設(shè)置復(fù)選按鈕選擇狀態(tài)CallInputData2(chkReverse,nFile)'讀入打印份數(shù)'讀入一行文本并存儲在變量中LineInput#nFile,strTemp'讀入打印份數(shù)Input#nFile,count'設(shè)置文本框文字txtNumber.Text=count'讀入是否打印到文件并設(shè)置復(fù)選按鈕選擇狀態(tài)CallInputData2(chkPlotToFile,nFile)'讀入打印路徑列表并添加到組合框中CallInputData(cboPlotPath,nFile)'讀入打印比例列表并添加到組合框中CallInputData(cboPlotScale,nFile)'讀入一行文本并存儲在變量中LineInput#nFile,strTemp'讀入當(dāng)前打印比例并設(shè)置文本框文字Input#nFile,xInput#nFile,ytxtNumerator.Text=xtxtDenominator.Text=y'讀入是否居中打印并設(shè)置復(fù)選按鈕選擇狀態(tài)CallInputData2(chkCenterPlot,nFile)'讀入打印偏移'讀入一行文本并存儲在變量中LineInput#nFile,strTemp'讀入打印偏移并設(shè)置文本框文字Input#nFile,xInput#nFile,ytxtOffsetX.Text=xtxtOffsetY.Text=y'讀入是否打印對象線寬并設(shè)置復(fù)選按鈕選擇狀態(tài)CallInputData2(chkPlotWithLineweights,nFile)'讀入是否采用打印樣式并設(shè)置復(fù)選按鈕選擇狀態(tài)CallInputData2(chkPlotWithPlotStyles,nFile)'讀入是否隱藏圖紙空間對象并設(shè)置復(fù)選按鈕選擇狀態(tài)CallInputData2(chkPlotHidden,nFile)'讀入圖框形式并設(shè)置單選按鈕選擇狀態(tài)'讀入一行文本并存儲在變量中LineInput#nFile,strTemp'讀入圖框形式Input#nFile,strTemp'設(shè)置單選按鈕選擇狀態(tài)IfstrTemp="圖塊"ThenoptBlock.Value=TrueElseoptLayer.Value=TrueEndIf'讀入圖塊名列表并添加到組合框中CallInputData(cboBlockName,nFile)'讀入圖層名列表并添加到組合框中CallInputData(cboLayerName,nFile)'關(guān)閉文件Close#nFileEndSubPrivateSubcmdListPrints_Click()'顯示AutoCAD中當(dāng)前可用的打印機(jī)列表CallListPrintersEndSubPrivateSubcmdOutput_Click()'導(dǎo)出打印設(shè)置'設(shè)置標(biāo)準(zhǔn)對話框WithcomDlg'設(shè)置標(biāo)準(zhǔn)對話框標(biāo)題.DialogTitle="導(dǎo)出打印設(shè)置"'設(shè)置標(biāo)準(zhǔn)對話框類型列表中所顯示的過濾器.Filter="文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"'設(shè)置標(biāo)準(zhǔn)對話框的起始目錄'.InDir="C:\"'設(shè)置[另存為]對話框的缺省擴(kuò)展名.DefaultExt="txt"'顯示[另存為]對話框.ShowSaveEndWithDimstrFileNameAsString,strTempAsStringstrFileName=comDlg.fileName'strFileName="F:\AutoCAD\丹通施工圖\打印設(shè)置.txt"'若返回文件名為空，不進(jìn)行操作IfstrFileName=""ThenMsgBox"請重新選擇保存位置！"ExitSubEndIf'保存文件的操作DimiAsInteger'打開文件OpenstrFileNameForOutputAs#1'輸出當(dāng)前路徑Print#1,"當(dāng)前路徑："Print#1,txtCurPath.Text'輸出打印文件列表Print#1,"打印文件列表："'輸出打印機(jī)配置列表的信息CallOutputData3(lstPlotFiles,1)'輸出打印機(jī)配置Print#1,"打印機(jī)配置："'輸出打印機(jī)配置列表的信息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)'輸出打印份數(shù)Print#1,"打印份數(shù)："Print#1,txtNumber.Text'輸出是否打印到文件Print#1,"是否打印到文件："CallOutputData2(chkPlotToFile,1)'輸出打印路徑Print#1,"打印路徑："'輸出打印路徑列表的信息CallOutputData(cboPlotPath,1)'輸出打印比例Print#1,"打印比例："'輸出打印比例列表的信息CallOutputData(cboPlotScale,1)'輸出當(dāng)前打印比例Print#1,"當(dāng)前打印比例："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)'關(guān)閉文件Close1EndSubPrivateSubcmdPick_Click()OnErrorResumeNextDimobjSelectAsAcadEntityDimptPickAsVariantDimstrTempAsStringSetobjDoc=ThisDrawing.Application.ActiveDocument'將控制權(quán)交給AutoCADfrmBatchPlot.Hide'在AutoCAD中選擇實(shí)體并判斷類型Retry:objDoc.Utility.GetEntityobjSelect,ptPick,vbCrLf&"請選擇實(shí)體："'處理按下Esc鍵的錯誤IfobjSelectIsNothingThenIfCheckKey(VK_ESCAPE)=TrueThen'顯示對話框frmBatchPlot.ShowExitSubElseGoToRetryEndIfEndIf'處理未選擇到實(shí)體的錯誤IfErr<>0ThenErr.ClearGoToRetryEndIf'若為指定圖塊IfoptBlock.Value=TrueThen'判斷實(shí)體是否塊參照IfTypeOfobjSelectIsAcadBlockReferenceThen'判斷實(shí)體是否模型空間、圖紙空間和匿名塊IfStrComp(Left(objSelect.Name,1),"*")<>0Then'獲得塊參照名strTemp=objSelect.NameElseMsgBox"您選擇的是匿名塊，請重新選擇塊參照！",vbCritical'顯示對話框frmBatchPlot.ShowExitSubEndIfElseMsgBox"您選擇的不是塊參照，請重新選擇塊參照！",vbCritical'顯示對話框frmBatchPlot.ShowExitSubEndIf'刷新塊參照列表CallListBlock'將所選塊參照在組合框中置為當(dāng)前CallSetSelected(cboBlockName,strTemp)Else'判斷實(shí)體是否多段線IfTypeOfobjSelectIsAcadLWPolylineThen'獲得多段線所在圖層名strTemp=objSelect.LayerElseMsgBox"您選擇的不是輕量多段線，請重新選擇輕量多段線！",vbCritical'顯示對話框frmBatchPlot.ShowExitSubEndIf'刷新圖層列表CallListLayer'將所選實(shí)體所在圖層在組合框中置為當(dāng)前CallSetSelected(cboLayerName,strTemp)EndIf'顯示對話框frmBatchPlot.ShowEndSubPrivateSubSetSelected(ListObjectAsObject,SItemAsString)'將該元素在組合框中置為當(dāng)前DimiAsLong'通過比較確定該元素的位置Fori=0To(ListObject.ListCount-1)IfStrComp(ListObject.List(i),SItem,vbTextCompare)=0ThenListObject.ListIndex=iExitSubEndIfNextEndSubPrivateSubcmdPreview_Click()'若按圖塊進(jìn)行批量打印IfoptBlock.Value=TrueThenIfcboBlockName.ListCount=0OrcboBlockName.Text=""ThenMsgBox"請先選擇塊參照！",vbCriticalExitSubEndIfCallPreviewByBlock(cboBlockName.Text)'若按圖層進(jìn)行批量打印ElseIfcboLayerName.ListCount=0OrcboLayerName.Text=""ThenMsgBox"請先選擇塊參照！",vbCriticalExitSubEndIfCallPreviewByLayer(cboLayerName.Text)EndIfEndSubPrivateSubcmdRefresh_Click()'刷新塊參照列表CallListBlock'刷新圖層列表CallListLayerEndSubPrivateSubcmdPlot_Click()'若按圖塊進(jìn)行批量打印IfoptBlock.Value=TrueThenIfcboBlockName.ListCount=0OrcboBlockName.Text=""ThenMsgBox"請先選擇塊參照！",vbCriticalExitSubEndIfCallBatchPlotByBlock(cboBlockName.Text)'若按圖層進(jìn)行批量打印ElseIfcboLayerName.ListCount=0OrcboLayerName.Text=""ThenMsgBox"請先選擇塊參照！",vbCriticalExitSubEndIfCallBatchPlotByLayer(cboLayerName.Text)EndIfEndSubPrivateSubcmdAbout_Click()'顯示關(guān)于對話框frmAbout.ShowEndSubPrivateSuboptBlock_Change()'設(shè)置“圖塊與圖層”組各控件激活狀態(tài)IfoptBlock.Value=TrueThenlbBlockName.Enabled=TruecboBlockName.Enabled=TruelbLayerName.Enabled=FalsecboLayerName.Enabled=FalseElselbBlockName.Enabled=FalsecboBlockName.Enabled=FalselbLayerName.Enabled=TruecboLayerName.Enabled=TrueEndIfEndSubPrivateSuboptLayer_Change()'設(shè)置“圖塊與圖層”組各控件激活狀態(tài)IfoptBlock.Value=TrueThenlbBlockName.Enabled=TruecboBlockName.Enabled=TruelbLayerName.Enabled=FalsecboLayerName.Enabled=FalseElselbBlockName.Enabled=FalsecboBlockName.Enabled=FalselbLayerName.Enabled=TruecboLayerName.Enabled=TrueEndIfEndSubPrivateSuboptMillimeters_Change()'設(shè)置圖紙單位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()'設(shè)置圖紙打印方向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)'設(shè)置自定義圖紙尺寸IfIsNumeric(txtDenominator)Then'設(shè)置組合框顯示項(xiàng)目為“自定義”cboPlotScale.ListIndex=0ElseMsgBox"請輸入數(shù)字！",vbCriticalEndIfEndSubPrivateSubtxtNumber_Change()'設(shè)置圖紙打印份數(shù)'objPlot.NumberOfCopies=CDbl(txtNumber.Text)'objPlot.NumberOfCopies=CInt(txtNumber.Text)objPlot.NumberOfCopies=txtNumber.ValueEndSubPrivateSubtxtNumerator_KeyPress(ByValKeyAsciiAsMSForms.ReturnInteger)'設(shè)置自定義圖紙尺寸IfIsNumeric(txtNumerator)Then'設(shè)置組合框顯示項(xiàng)目為“自定義”cboPlotScale.ListIndex=0ElseMsgBox"請輸入數(shù)字！",vbCriticalEndIfEndSubPrivateSubtxtOffsetX_KeyPress(ByValKeyAsciiAsMSForms.ReturnInteger)'設(shè)置自定義圖紙尺寸If(KeyAscii>=Asc("0")AndKeyAscii<=Asc("9"))OrKeyAscii=Asc(".")OrKeyAscii=Asc("-")Then'取消“居中打印”復(fù)選框chkCenterPlot.Value=FalseElseMsgBox"請輸入數(shù)字！",vbCriticalEndIfEndSubPrivateSubtxtOffsetY_KeyPress(ByValKeyAsciiAsMSForms.ReturnInteger)'設(shè)置自定義圖紙尺寸If(KeyAscii>=Asc("0")AndKeyAscii<=Asc("9"))OrKeyAscii=Asc(".")OrKeyAscii=Asc("-")Then'取消“居中打印”復(fù)選框chkCenterPlot.Value=FalseElseMsgBox"請輸入數(shù)字！",vbCriticalEndIfEndSubPrivateSubUserForm_Initialize()SetobjDoc=ThisDrawing.Application.ActiveDocumentSetobjLayout=ThisDrawing.ActiveLayoutSetobjPlot=ThisDrawing.Plot'禁用“當(dāng)前路徑”文本框txtCurPath.Enabled=False'列出當(dāng)前所有打印機(jī)CallListPrinters'顯示AutoCAD中當(dāng)前可用的打印比例列表CallListPlotScale'設(shè)置“打印到文件”是否選中chkPlotToFile.Value=False'禁用“打印到文件”組各控件lbPlotPath.Enabled=FalsecboPlotPath.Enabled=FalsecmdBrowse2.Enabled=False'顯示AutoCAD中當(dāng)前可用的圖塊CallListBlock'顯示AutoCAD中當(dāng)前可用的圖層CallListLayerEndSubPublicFunctionReturnFolder(lngHwndAsLong)AsStringDimBrowserAsBrowseInfoDimlngFolderAsLongDimstrPathAsStringDimstrTempAsStringWithBrowser.hOwner=lngHwnd.lpszTitle="選擇工作路徑".pszDisplayName=String(MAX_PATH,0)EndWith'用空格填充字符串strPath=String(MAX_PATH,0)'調(diào)用API函數(shù)顯示文件夾列表lngFolder=SHBrowseForFolder(Browser)'使用API函數(shù)獲取返回的路徑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"發(fā)生下面的錯誤："&Err.NumberAddToList=FalseEndFunctionPrivateFunctionHasItem(objBoxAsListBox,strFliesAsString)AsBoolean'檢查路徑是否已經(jīng)存在HasItem=FalseDimiAsIntegerIfobjBox.ListCount>0ThenFori=0ToobjBox.ListCount-1IfStrComp(objBox.List(i),strFlies,vbTextCompare)=0ThenHasItem=TrueExitFunctionEndIfNextiEndIfEndFunctionPrivateFunctionHasItem2(ByValstrPathAsString)AsInteger'檢查路徑是否已經(jīng)存在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個圖形文件已經(jīng)被打開，則將其激活I(lǐng)fstrFile=fileNameThen'若dwgFile尚未激活，則將其激活I(lǐng)fdwgFile.Active=FalseThenThisDrawing.Application.ActiveDocument=dwgFileEndIfExitSubEndIfNext'若第i個圖形文件尚未被打開，則將其打開ThisDrawing.Application.Documents.OpenfileNameEndSub'顯示AutoCAD中當(dāng)前可用的打印機(jī)列表PublicSubListPrinters()objLayout.RefreshPlotDeviceInfo'獲得所有的可用打印機(jī)DimplotDevices

AsVariantplotDevices=objLayout.GetPlotDeviceNames'刪除以前的打印機(jī)列表cboPrintersName.Clear'顯示打印機(jī)列表DimiAsIntegerFori=0ToUBound(plotDevices)cboPrintersName.AddItem(plotDevices(i))Nexti'設(shè)置組合框初始選項(xiàng)WithcboPrintersName'使用下拉列表的形式.Style=fmStyleDropDownList'設(shè)置下拉列表的下標(biāo)下限.BoundColumn=0'設(shè)置默認(rèn)的顯示項(xiàng)目.ListIndex=1EndWithEndSub'顯示AutoCAD中當(dāng)前可用的打印樣式PublicSubListPlotStyleTableNames()SetobjLayout=ThisDrawing.ActiveLayoutobjLayout.RefreshPlotDeviceInfo'獲得所有的可用打印樣式DimplotStyleTables

AsVariantplotStyleTables=objLayout.GetPlotStyleTableNames'刪除以前的打印樣式列表cboPlotStyleTableNames.Clear'顯打印樣式列表DimiAsIntegerFori=0ToUBound(plotStyleTables)cboPlotStyleTableNames.AddItem(plotStyleTables(i))Nexti'設(shè)置組合框初始選項(xiàng)WithcboPlotStyleTableNames'使用下拉列表的形式.Style=fmStyleDropDownList'設(shè)置下拉列表的下標(biāo)下限.BoundColumn=0'設(shè)置默認(rèn)的顯示項(xiàng)目.ListIndex=0EndWithEndSub'顯示AutoCAD中當(dāng)前可用的圖紙尺寸PublicSubListPaperSize()objLayout.RefreshPlotDeviceInfo'獲得所有當(dāng)前可用可用圖紙尺寸列表DimpaperSizes

AsVariantpaperSizes=objLayout.GetCanonicalMediaNames'刪除以前的圖紙尺寸列表cboPaperSize.Clear'顯示圖紙尺寸列表DimiAsIntegerFori=0ToUBound(paperSizes)cboPaperSize.AddItem(paperSizes(i))Nexti'設(shè)置組合框初始選項(xiàng)WithcboPaperSize'使用下拉列表的形式.Style=fmStyleDropDownList'設(shè)置下拉列表的下標(biāo)下限.BoundColumn=0'設(shè)置默認(rèn)的顯示項(xiàng)目.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'設(shè)置下拉列表的下標(biāo)下限.BoundColumn=0'設(shè)置默認(rèn)的顯示項(xiàng)目.ListIndex=2EndWithtxtNumerator=1txtDenominator=1EndSub'顯示AutoCAD中當(dāng)前可用的圖層PublicSubListLayer()DimLayerListAsCollection'獲得圖形中存在的圖層列表SetLayerList=GetLayerList()'刷新圖層列表CallRefreshList(cboLayerName,LayerList)'選擇圖層列表中的第一個實(shí)體IfcboLayerName.ListIndex=-1ThencboLayerName.ListIndex=0EndIfEndSub'獲得圖形中存在的圖層列表PrivateFunctionGetLayerList()AsCollectionDimobjLayerAsAcadLayerDimLayerListAsNewCollectionSetobjDoc=ThisDrawing.Application.ActiveDocument'獲得可用的圖層ForEachobjLayerInobjDoc.LayersLayerList.AddobjLayer.Name,objLayer.NameNext'返回圖形中塊參照的列表SetGetLayerList=LayerListEndFunction'顯示AutoCAD中當(dāng)前可用的圖塊PublicSubListBlock()DimBlockReferenceListAsCollection'獲得圖形中存在的塊參照列表SetBlockReferenceList=GetBlockReferences()'判斷是否存在塊參照IfBlockReferenceListIsNothingThenMsgBox"當(dāng)前圖形中不存在任何的塊！",vbExclamationExitSubEndIf'刷新塊參照列表CallRefreshList(cboBlockName,BlockReferenceList)'選擇塊參照列表中的第一個實(shí)體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'元素?cái)?shù)目小于1，不進(jìn)行排序IfListObject.ListCount=0ThenListObject.AddItemSItemExitSubEndIf'通過比較確定該元素的位置，類似于插入排序法Fori=0To(ListObject.ListCount-1)IfStrComp(ListObject.List(i),SItem,vbTextCompare)=1ThenListObject.AddItemSItem,iExitSubEndIfNext'添加到列表框的最后ListObject.AddItemSItemEndSubPublicSubPaperRotationChange()'設(shè)置圖紙打印方向IfoptVertical.Value=TrueThenIfchkReverse.Value=FalseThenobjLayout.PlotRotation=ac0degreesElseobjLayout.PlotRotation=ac180degreesEndIfElseIfchkReverse.Value=FalseThenobjLayout.PlotRotation=ac90degreesElseobjLayout.PlotRotation=ac270degreesEndIfEndIf'顯示圖紙大小CallSetPlotZoneEndSub'設(shè)置圖紙可打印區(qū)域大小PublicSubSetPlotZone()DimWidthAsDouble,HeightAsDouble,tAsDouble'獲得圖紙大小objLayout.GetPaperSizeWidth,Height'圖形方向?yàn)椤皺M向”時寬高互調(diào)IfoptVertical.Value=FalseThent=WidthWidth=HeightHeight=tEndIf'單位由“毫米”轉(zhuǎn)換為“英寸”IfoptMillimeters.Value=FalseThenWidth=Width/25.393Height=Height/25.393EndIf'顯示圖紙大小lbPaperSize.Caption=Round(Width,2)&"×"&Round(Height,2)EndSubPrivateSubOutputData(objBoxAsComboBox,nFileAsInteger)DimiAsInteger,countAsInteger,indexAsInteger'獲得組合框列表數(shù)目count=objBox.ListCount'獲得組合框當(dāng)前選項(xiàng)的的索引號index=objBox.ListIndex'輸出組合框列表數(shù)目Write#nFile,count'輸出組合框當(dāng)前選項(xiàng)的的索引號Write#nFile,index'輸出所有的組合框選項(xiàng)Fori=0Tocount-1Print#nFile,objBox.List(i)NextEndSubPrivateSubOutputData2(objBoxAsCheckBox,nFileAsInteger)DimstrTempAsString'輸出復(fù)選框選中狀態(tài)IfobjBox.Value=TrueThenstrTemp="是"ElsestrTemp="否"EndIfPrint#nFile,strTempEndSubPrivateSubOutputData3(objBoxAsListBox,nFileAsInteger)DimiAsInteger,countAsInteger,indexAsInteger'獲得列表框列表數(shù)目count=objBox.ListCount'獲得列表框當(dāng)前選項(xiàng)的的索引號index=objBox.ListIndex'輸出列表框列表數(shù)目Write#nFile,count'輸出列表框當(dāng)前選項(xiàng)的的索引號Write#nFile,index'輸出所有的列表框選項(xiàng)Fori=0Tocount-1Print#nFile,objBox.List(i)NextEndSubPrivateSubInputData(objBoxAsComboBox,nFileAsInteger)DimiAsInteger,countAsInteger,indexAsIntegerDimstrTempAsString'讀入一行文本并存儲在變量中LineInput#nFile,strTemp'讀入組合框列表數(shù)目Input#nFile,count'讀入組合框當(dāng)前元素的的索引號Input#nFile,index'清空組合框所有元素objBox.Clear'讀入組合框元素Fori=0Tocount-1LineInput#nFile,strTemp'將讀入的列表添加到組合框中objBox.AddItemstrTempNext'設(shè)置組合框初始選項(xiàng)WithobjBox'使用下拉列表的形式.Style=fmStyleDropDownList'設(shè)置下拉列表的下標(biāo)下限.BoundColumn=0'設(shè)置默認(rèn)的顯示項(xiàng)目.ListIndex=indexEndWithEndSubPrivateSubInputData2(objBoxAsCheckBox,nFileAsInteger)DimstrTempAsString'讀入一行文本并存儲在變量中LineInput#nFile,strTemp'讀入復(fù)選框選中狀態(tài)Input#nFile,strTemp'設(shè)置復(fù)選按鈕選擇狀態(tài)IfstrTemp="是"ThenobjBox.Value=TrueElseobjBox.Value=FalseEndIfEndSubPrivateSubInputData3(objBoxAsListBox,nFileAsInteger)DimiAsInteger,countAsInteger,indexAsIntegerDimstrTempAsString'讀入一行文本并存儲在變量中LineInput#nFile,strTemp'讀入列表框列表數(shù)目Input#nFile,count'讀入列表框當(dāng)前元素的的索引號Input#nFile,index'清空列表框所有元素objBox.Clear'讀入列表框元素Fori=0Tocount-1LineInput#nFile,strTemp'將讀入的列表添加到列表框中objBox.AddItemstrTempNext'設(shè)置組合框初始選項(xiàng)WithobjBox'設(shè)置下拉列表的下標(biāo)下限.BoundColumn=0'設(shè)置默認(rèn)的顯示項(xiàng)目.ListIndex=indexEndWithEndSubPublicSubSetPrinter()'設(shè)置打印機(jī)配置objLayout.ConfigName=cboPrintersName.Text'設(shè)置打印樣式表objLayout.StyleSheet=cboPlotStyleTableNames.Text'設(shè)置圖紙尺寸objLayout.CanonicalMediaName=cboPaperSize.Text'設(shè)置圖紙單位IfoptMillimeters.Value=TrueThenobjLayout.PaperUnits=acMillimetersElseobjLayout.PaperUnits=acInchesEndIf'設(shè)置圖紙打印方向IfoptVertical.Value=TrueThenIfchkReverse.Value=FalseThenobjLayout.PlotRotation=ac0degreesElseobjLayout.PlotRotation=ac180degreesEndIfElseIfchkReverse.Value=FalseThenobjLayout.PlotRotation=ac90degreesElseobjLayout.PlotRotation=ac270degreesEndIfEndIf'設(shè)置圖紙打印比例IfcboPlotScale.ValueThenobjLayout.UseStandardScale=True

'使用標(biāo)準(zhǔn)打印比例ElseobjLayout.UseStandardScale=False'使用自定義打印比例EndIfSelectCasecboPlotScale.ValueCase0'設(shè)置自定義打印比例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