Makro zum Löschen aller bis auf einige Ebenen

Out of category
1

Hallo ihr alle

Ich möchte die Benennung meiner Layer in SOLIDWORKS automatisieren.

In meinem Beispiel haben wir eine Reihe von Layern, die wir nicht mehr verwenden, die aber in alten Flugzeugen vorhanden sind.

Wenn ich die alten Pläne retuschieren möchte, möchte  ich alle Layer bis auf einige Layer  löschen (Bemaßungen, Anmerkungen, Zeichnung, IndexA, Index B Index....)

Ich weiß, wie man alle Ebenen löscht, aber einige nicht ausschließt.

Hier ist mein Makro angehängt

Vielen Dank im Voraus für Ihre Hilfe.

 


supprimer_tous_les_calques.swp
2

Hallo Yannick. Probiere das mal aus:

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 „Gefällt mir“
3

Hallo

Vielen Dank für das schnelle Feedback Jérôme, ich werde es morgen testen.

Kleine zusätzliche Frage, ist es möglich, den Ebenen Farben hinzuzufügen?

Layer, Maße, Beschriftung in schwarz

Rote Index-Layer

  Heidekraut

 

4

Ich habe den Code für die Farben aktualisiert.

1 „Gefällt mir“
5

Hallo Jerome,

Das Makro erstellt die Layer nicht.

Ich habe das Makro Schritt für Schritt ausgeführt, das Makro geht von Für jeden zum Ende des Subs, ohne zu berücksichtigen , was dazwischen  liegt (unten unterstrichen).

  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

Es kann passieren, wenn keine Schichten vorhanden sind

Sie können dies überprüfen, indem Sie 'debug.print vLayer ' nach dem für einfügen

Können Sie eine Zeichnung + 3D zum Testen sowie die swp-Datei anhängen? 

1 „Gefällt mir“
7

Hier ist der Dateityp, den ich mit dem Makro nachbessern muss

Manchmal haben Sie auf alten Plänen keine Ebenen oder sogar Dateien ohne Ebenen.

Bei der Datei ohne Ebene führt das Makro keine Aktion aus.

Bei der Datei mit Ebenen löscht das Makro alle Ebenen außer den Dimensionen, der Index wird nicht berücksichtigt

 


calques.zip
8

Hier ist der Dateityp, den ich mit dem Makro nachbessern muss

Manchmal haben Sie auf alten Plänen keine Ebenen oder sogar Dateien ohne Ebenen.

Auf der Datei ohne Ebene  führt das Makro keine Aktionen aus.

In der Datei mit Layern löscht das Makro alle Layer mit Ausnahme der Bemaßungen, aber die Index-Layer.


calques.zip
9

Löschen Sie alle Layer  außer Indexdimension .... , das Makro funktioniert, wenn eine Ebene vorhanden ist.

In dem Moment, in dem Hinweis A, Hinweis B gelöscht werden, wird diese Befehlszeile nicht berücksichtigt

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

 

Ich habe durch diese Befehle ersetzt, es funktioniert.

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

     

         

10

Vielen Dank für das gestrige Feedback, Jerome,

Auf der anderen Seite Informationen, die ich nicht berücksichtigt hatte

  1. Erstellen der Layer Dimension, IndexA, IndexB...... wenn sie nicht vorhanden sind.

Ist es möglich?

11

Fügen Sie eine Ebene hinzu mit:

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

1 „Gefällt mir“
12

Hallo Jerome,

Die Zeile: cot = swLayerMgr.AddLayer("dimension", "", 0, swLayerMgr.swLineCONTINUOUS, swLineWeights_e.swLW_THIN)

die Sie mir gestern zur Verfügung gestellt haben, zeigt mir einen Fehler

 

Ich habe durch diese Zeile ersetzt

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

 

Gibt es eine Einstellung, um eine bestimmte Ebene zu aktivieren, wenn es keine Ebene in der Hintergrundkarte gibt, die verarbeitet werden soll?


 

13

Hier ist das Makro


maj_calques.swp
14

So sehr ich bei mir beim Kopieren-Einfügen einen Fehler gemacht habe, so ist es auch:

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

 

Können Sie die Frage klären: "Gibt es einen Parameter, um eine bestimmte Ebene zu aktivieren, wenn es im Hintergrundplan keine Ebene gibt, die bearbeitet werden soll?"

1 „Gefällt mir“
15

Beim Ausführen des Makros werden die Layer gut erstellt

Wenn auf der verarbeiteten Ebene keine Ebene vorhanden ist, gibt es keine aktiven Ebenen, wenn die Verarbeitung des Makros abgeschlossen ist

 Aktive Schicht ist die Ebene mit   einem Pfeil  (siehe PC)

Ich möchte eine aktive Ebene setzen, wenn ich die Ebenen mit dem Makro erstelle. 

Beispiel:  Aktiver Zeichnungs-Layer

 

 


download.jpeg.jpg
16

Sie müssen Folgendes eingeben:

swLayerMgr.SetCurrentLayer "Nom_du_calque"

Um es aktiv zu machen

1 „Gefällt mir“