Macro om alle lagen te verwijderen, op enkele na

Out of category
1

Hoi allemaal

Ik ben op zoek naar een manier om de naamgeving van mijn lagen in solidworks te automatiseren.

In mijn voorbeeld hebben we een aantal lagen die we niet meer gebruiken, maar die in oude vlakken bestaan.

Als ik de oude plannen wil retoucheren, wil  ik alle lagen verwijderen, behalve enkele lagen  (afmetingen, annotaties, tekening, IndexA, Index B Index....)

Ik weet hoe ik alle lagen kan verwijderen, maar er geen enkele kan uitsluiten.

Hier is bijgevoegd mijn macro

Bij voorbaat dank voor uw hulp.

 


supprimer_tous_les_calques.swp
2

Hallo Yannick. Probeer het volgende:

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

Hallo

Bedankt voor de snelle feedback Jérôme, ik zal het morgen testen.

Kleine extra vraag, is het mogelijk om kleuren toe te voegen aan de lagen?

Lagen, afmetingen, annotatie in zwart

Rode indexlagen

  Heide

 

4

Ik heb de code voor de kleuren bijgewerkt.

1 like
5

Hallo Hiëronymus,

De macro maakt de lagen niet.

Ik heb de macro stap voor stap uitgevoerd, de macro gaat van Voor elk naar einde sub zonder rekening te houden met  wat er tussenin  zit (hieronder onderstreept.

  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

Het kan gebeuren als er geen lagen zijn

U kunt dit controleren door 'debug.print vLayer ' achter de for te zetten 

Kunt u een tekening + 3D bijvoegen om te testen, evenals het swp-bestand .

1 like
7

Dit is het type bestand dat ik moet bijwerken met de macro

Soms heb je geen lagen op oude plannen of zelfs bestanden zonder lagen.

Op het bestand zonder laag doet de macro niets.

Op het bestand met lagen verwijdert de macro alle lagen behalve afmetingen, er wordt geen rekening gehouden met de index

 


calques.zip
8

Dit is het type bestand dat ik moet bijwerken met de macro

Soms heb je geen lagen op oude plannen of zelfs bestanden zonder lagen.

Het is op het bestand zonder laag dat  de macro niets doet.

In het bestand met lagen worden alle lagen behalve de afmetingen van de macro verwijderd, maar worden indexlagen verwijderd.


calques.zip
9

Verwijder  alle lagen behalve indexdimensie .... , de macro werkt als er een laag bestaat.

Op het moment dat Aanwijzing A, Aanwijzing B, worden verwijderd, wordt er geen rekening gehouden met deze opdrachtregel

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

 

Ik heb vervangen door deze commando's, het werkt.

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

     

         

10

Bedankt voor de feedback van gisteren Jerome,

Aan de andere kant informatie waar ik geen rekening mee had gehouden 

  1. de lagen Dimensie, IndexA, IndexB...... maken als ze niet aanwezig zijn.

Is het mogelijk?

11

Voeg een laag toe met:

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

1 like
12

Hallo Hiëronymus,

De lijn: cot = swLayerMgr.AddLayer("dimensie", "", 0, swLayerMgr.swLineCONTINUOUS, swLineWeights_e.swLW_THIN)

Dat je me gisteren hebt gegeven, toont me een fout

 

Ik heb deze regel vervangen

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

 

Is er een instelling om een specifieke laag te activeren als er geen laag in de achtergrondkaart is die moet worden verwerkt?


 

13

Hier is de macro


maj_calques.swp
14

Hoezeer ik ook voor mij een fout heb gemaakt tijdens het copy-paste , het is:

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

 

Kunt u de vraag verduidelijken: "is er een parameter om een specifieke laag te activeren als er geen laag in het achtergrondplan is dat moet worden verwerkt?"

1 like
15

Bij het uitvoeren van de macro worden de lagen goed gemaakt

Als er geen laag aanwezig is op de verwerkte laag, zijn er geen actieve lagen wanneer de macro is verwerkt

 Actieve laag is de laag met   een pijl  (zie PC)

Ik wil een actieve laag instellen bij het maken van de lagen met de macro. 

Bijvoorbeeld,  actieve tekenlaag

 

 


download.jpeg.jpg
16

Je moet erin zetten:

swLayerMgr.SetCurrentLayer "Nom_du_calque"

Om het actief te maken

1 like