CAD批量删除图层VBA程序.doc

《CAD批量删除图层VBA程序.doc》由会员上传分享，免费在线阅读，更多相关内容在教育资源-天天文库。

1、'按钮点击执行函数，以TK图层为例，要删除TK图层，可以修改删除图层的名称。总体思路是，先记录文件夹的地址，然后依次打开文件，判断TK图层是否存在，不存在跳到下一个文件打开。如果存在，就选取TK图层，并删除TK图层@七月寒翎沐出品PrivateSubCommandButton11_Click()CommonDialog2.CancelError=TrueWithCommonDialog2.Filter="*.dwg

2、*.dwg".ShowSaveDimAAsStringA=Trim(.FileName)i=InStrRev(A,"")My

3、Path=Mid(A,1,i)'文件目录EndWithUserForm1.hideDimMyFile,MyNameAsStringMyFile=Dir(MyPath&"*.dwg")DoWhileMyFile<>""'开始循环。nextline=Trim(MyFile)gangwei=InStrRev(nextline,".")MyName1=Mid(nextline,1,gangwei-1)ThisDrawing.Application.Documents.OpenMyPath&MyName1&".dwg"'打开文件Dimlayerexi

4、tAsBooleanlayerexit=FalseDimMyLayAsAcadLayerForEachMyLayInThisDrawing.Layers'判断图层是否存在IfMyLay.name="TK"Thenlayerexit=TrueNextIflayerexitthenDelAllInLayer("TK")'删除TK图层EndIfThisDrawing.Application.Documents(MyName1&".dwg").Save'保存文件ThisDrawing.CloseMyFile=DirLoopEndSub'删除图层函数

5、FunctionDelAllInLayer(ByValLNameAsString)'清除选择集OnErrorResumeNextCallThisDrawing.SelectionSets("sssl").DeleteOnErrorResumeNext'创建选择集DimSSetAsAcadSelectionSetSetSSet=ThisDrawing.SelectionSets.Add("sssl")Dimft(0)AsInteger,Fd(0)ft(0)=8:Fd(0)=Lname'要问ft(0)为什么是8，下面的选择函数里，ft(0)是D

6、XF组码，你转出一个dxf，然后用记事本打开，就可以看出来，dxf里面，图层的组码就是8'选中符合选择条件的元素，这个是选中指定图层名的所有元素SSet.SelectacSelectionSetAll,,,ft,Fd'循环删除选择集里每一个元素DimEAsAcadEntityForEachEInSSetE.Delete'删除NextEndFunction七月寒翎沐