Macro to delete all but some layers

Out of category
1

Hi all

I'm looking to automate the naming of my layers in solidworks.

In my example, we have a number of layers that we don't use anymore but exist in old planes.

When I want to retouch the old plans, I would  like to delete all the layers except some layers  (dimensions, annotations, drawing, IndexA, Index B Index....)

I know how to delete all layers but not exclude some.

here is attached my macro

Thank you in advance for your help.

 


supprimer_tous_les_calques.swp
2

Hello Yannick. Try this:

Option Explicit
    Dim swApp                       As SldWorks.SldWorks
    Dim swModel                     As SldWorks.ModelDoc2
    Dim swLayerMgr                  As SldWorks.LayerMgr
    Dim swLayer                     As SldWorks.Layer
    Dim vLayerArr                   As Variant
    Dim vLayer                      As Variant
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        swApp.SendMsgToUser2 "pas de documents ouvert", swMbWarning, swMbOk
        Exit Sub
    End If
    
    If swModel.GetType <> 3 Then
        swApp.SendMsgToUser2 "Ouvrir une mise en plan", swMbWarning, swMbOk
        Exit Sub
    End If
    swModel.ViewZoomtofit2
    
    Set swLayerMgr = swModel.GetLayerManager
    vLayerArr = swLayerMgr.GetLayerList

    Dim LayerList As Object
    Set LayerList = CreateObject("Scripting.Dictionary")
    LayerList.Add "cotations", 0
    LayerList.Add "Annotations", 0
    LayerList.Add "dessin", 0
    LayerList.Add "IndiceA", 0
    LayerList.Add "IndiceB", 0

    For Each vLayer In vLayerArr
        Set swLayer = swLayerMgr.GetLayer(vLayer)
        If Not LayerList.Exists(swLayer.Name) Then
            Debug.Print "Supprime " & swLayer.Name
            swLayerMgr.DeleteLayer swLayer.Name
        ElseIf swLayer.Name = "cotations" Then
            swLayer.Color = 0
        ElseIf InStr(swLayer.Name, "Indice") > 0 Then
            swLayer.Color = 255
        End If
    Next
End Sub

 

3 Likes
3

Hello

Thank you for the quick feedback Jérôme, I'll test it tomorrow.

Small additional question, is it possible to add colors to the layers?

Layers, dimensions, annotation in black

Red Index Layers

  Heather

 

4

I updated the code for the colors.

1 Like
5

Hello Jerome,

The macro does not create the layers.

I ran the macro step by step, the macro goes from For each to end sub without taking into account  what is in between  (underlined below.

  For Each vLayer In vLayerArr
        Set swLayer = swLayerMgr.GetLayer(vLayer)
        If Not LayerList.Exists(swLayer.Name) Then
            Debug.Print "Supprime " & swLayer.Name
            swLayerMgr.DeleteLayer swLayer.Name
        ElseIf swLayer.Name = "cotations" Then
            swLayer.Color = 0
        ElseIf InStr(swLayer.Name, "Indice") > 0 Then
            swLayer.Color = 255
        End If
    Next
End Sub
6

It can happen if there are no layers

You can check by putting 'debug.print vLayer ' after the for

Can you attach a drawing + 3D for testing, as well as the swp file .

1 Like
7

Here's the type of file I need to touch up with the macro

Sometimes you don't have any layers on old plans or even files without layers.

On the file without layer, the macro does nothing.

On the file with layers, the macro deletes all layers except dimensions, index is not taken into account

 


calques.zip
8

Here is the type of file that I need to touch up with the macro

Sometimes you don't have any layers on old plans or even files without layers.

it's on the file without layer that  the macro doesn't do anything.

On the file with layers, the macro deletes all layers except dimensions, but deletes index layers.


calques.zip
9

Delete  all layers except index dimension .... , the macro works if a layer exists.

At the moment Clue A, Clue B, are deleted, this command line is not taken into account

 ElseIf InStr(swLayer.Name, "Indice") > 0 Then
            swLayer.Color = 255

 

I replaced with these commands, it works.

ElseIf swLayer.Name = "IndiceA" Then
            swLayer.Color = 255
ElseIf swLayer.Name = "IndiceB" Then
            swLayer.Color = 255

     

         

10

Thank you for yesterday's feedback Jerome,

On the other hand, information that I had not taken into account 

  1. create the Dimension, IndexA, IndexB...... layers if they are not present.

Is it possible?

11

Add a layer with:

swLayerMgr.AddLayer("Dimension", "", 0, swLayerMgr.swLineCONTINUOUS, swLineWeights_e.swLW_THIN)

1 Like
12

Hello Jerome,

The line: cot = swLayerMgr.AddLayer("dimension", "", 0, swLayerMgr.swLineCONTINUOUS, swLineWeights_e.swLW_THIN)

that you provided me yesterday shows me an error

 

I replaced with this line

cot = swLayerMgr.AddLayer("Dimension", "", RGB(0, 0, 0), 0, 0)

 

Is there a setting to activate a specific layer if there is no layer in the background map to be processed?


 

13

Here's the macro


maj_calques.swp
14

As much as for me I made a mistake during the copy-paste it is:

cot = swLayerMgr.AddLayer("dimension", "", 0, swLineStyles_e.swLineCONTINUOUS, swLineWeights_e.swLW_THIN)

 

Can you clarify the question: "is there a parameter to activate a specific layer if there is no layer in the background plan to be processed?"

1 Like
15

When running the macro, the layers are created well

If there is no layer present on the processed layer, there will be no active layers when the macro is finished processing

 Active layer is the layer with   an arrow  (see PC)

I want to set an active layer when creating the layers with the macro. 

For example,  active drawing layer

 

 


download.jpeg.jpg
16

You have to put in:

swLayerMgr.SetCurrentLayer "Nom_du_calque"

To make it active

1 Like