CAD批量删除图层VBA程序

'按钮点击执行函数，以TK图层为例，要删除TK图层，可以修改删除图层的名称。总体思路是，先记录文件夹的地址，然后依次打开文件，判断TK图层是否存在，不存在跳到下一个文件打开。如果存在，就选取TK图层，并删除TK图层@七月寒翎沐出品PrivateSubCommandButton11_Click()CommonDialog2.CancelError=TrueWithCommonDialog2.Filter=*.dwg|*.dwg.ShowSaveDimAAsStringA=Trim(.FileName)i=InStrRev(A,\)MyPath=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'打开文件DimlayerexitAsBooleanlayerexit=FalseDimMyLayAsAcadLayerForEachMyLayInThisDrawing.Layers'判断图层是否存在IfMyLay.name=TKThenlayerexit=TrueNextIflayerexitthenDelAllInLayer(TK)'删除TK图层EndIfThisDrawing.Application.Documents(MyName1&.dwg).Save'保存文件ThisDrawing.CloseMyFile=DirLoopEndSub'删除图层函数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)是DXF组码，你转出一个dxf，然后用记事本打开，就可以看出来，dxf里面，图层的组码就是8'选中符合选择条件的元素，这个是选中指定图层名的所有元素SSet.SelectacSelectionSetAll,,,ft,Fd'循环删除选择集里每一个元素DimEAsAcadEntityForEachEInSSetE.Delete'删除NextEndFunction七月寒翎沐