Hi everyone, here a simple vba code to delete layers. It previously erases all the layer's content in order to make deletion possible. Hope it helps someone.
First of all, you need to create a UserForm with a ListBox control named "LBLayers", which must have the MultiSelect property set to "2-fmMultiSelectExtended". Also you´ll need a command button named "CBEraseLayer", and a quit control if you want.
Option ExplicitPublic Sub LoadLayersList(LList As ListBox) Dim tlay As AcadLayer LList.Clear For Each tlay In ThisDrawing.Layers Call LList.AddItem(tlay.Name) Next tlay LList.ListIndex = 0 End SubPrivate Sub CBEraseLayer_Click() Dim tlay As AcadLayer Dim sset As AcadSelectionSet Dim FilterType(0) As Integer Dim FilterData(0) As Variant Dim nlays As Integer, i As Integer nlays = LBLayers.ListCount If ThisDrawing.SelectionSets.Count >= 1 Then For i = ThisDrawing.SelectionSets.Count - 1 To 0 Step -1 ThisDrawing.SelectionSets.Item(i).Delete Next i End If FilterType(0) = 8 For i = 0 To nlays - 1 If LBLayers.Selected(i) Then FilterData(0) = LBLayers.List(i) Set sset = ThisDrawing.SelectionSets.Add("SSAUX01") Call sset.Select(acSelectionSetAll, , , FilterType, FilterData) Call sset.Erase Call sset.Delete ThisDrawing.Layers.Item(LBLayers.List(i)).Delete End If Next i Call LoadLayersList(LBLayers) Exit SubEnd SubPrivate Sub CBQuit_Click() UFEraseLayer.HideEnd SubPrivate Sub UserForm_Activate() Call LoadLayersList(LBLayers)End Sub
Also, you will need a module with a sub in order to launch the macro from autocad, the launcher could be something like this
The UserForm loads all the layers names on the ListBox and let´s the user to select which layers are going to be deleted.
Regarding your question, no, it doesn´t check that layer "0" cannot be deleted, so adding an if inside the layers list to avoid this situation that clearly would lead to a runtime error, would improve the code. Also, check if the layer is locked or not and ask if you want to delete it anyway. In that case, unlock the layer and proceed, otherwise don´t try to delete the objects inside the layer, this also would lead to a runtime error.
My apologies, the text I've places few minutes ago is almost unreadable, (I'm out of fit with my english). I hope you can understand what I've tried to say, if you want I can rethink the message, it would be a nice exercise.
(defun DeleteLayer(Name / layCol dLay oVal) (vl-load-com) (if (and (/= Name "0") ; Check its not Layer 0 (/= (strcase Name)(getvar "CLAYER")) ; Check its not Current Layer ); end or (progn (setq layCol(vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object)))) ; Retrieve Current Layer Collection (if(vl-catch-all-error-p (setq dLay(vl-catch-all-apply 'vla-Item (list layCol(strcat Name))))) ; Retrieve Layer Object Name from Layer Collection? (princ "\nLayer does not exist! ") (if(vl-catch-all-error-p (vl-catch-all-apply 'vla-Delete (list dLay))) ; If Possible, Delete the Layer (princ "\nCan't delete layer in use! ") (setq oVal T) ); end if ); end if ); end progn (princ "\nCan't delete active layer or layer "0"! ") ); end if oVal); end of DeleteLayer
Thanks, Lisp is a pending issue. Despite that I'm able to do some programming using other list oriented languages/programs, such as Mathematica, I´ve never been able to do something using Lisp. Probably the best time investement would be in ObjectARX or something related to .NET, what do you think about?
置顶卡
