Makro do usuwania wszystkich warstw z wyjątkiem niektórych

Out of category
1

Cze wszystkim

Chcę zautomatyzować nazewnictwo moich warstw w solidworks.

W moim przykładzie mamy wiele warstw, których już nie używamy, ale które istnieją w starych płaszczyznach.

Kiedy chcę wyretuszować stare plany,  chciałbym usunąć wszystkie warstwy z wyjątkiem niektórych warstw  (wymiary, adnotacje, rysunek, Indeks A, Indeks B, Indeks B....)

Wiem, jak usunąć wszystkie warstwy, ale nie wykluczać niektórych.

Tu załączam moje makro

Z góry dziękuję za pomoc.

 


supprimer_tous_les_calques.swp
2

Witaj Yannick. Spróbuj tego:

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 polubienia
3

Witam

Dziękuję za szybką informację zwrotną Jérôme, jutro to przetestuję.

Małe dodatkowe pytanie, czy można dodać kolory do warstw?

Warstwy, wymiary, adnotacje w kolorze czarnym

Czerwone warstwy indeksu

  Wrzos

 

4

Zaktualizowałem kod kolorów.

1 polubienie
5

Witaj Hieronim,

Makro nie tworzy warstw.

Uruchomiłem makro krok po kroku, makro przechodzi od Dla każdego do końca sub bez uwzględnienia  tego, co jest pomiędzy  (podkreślone poniżej.

  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

Może się to zdarzyć, jeśli nie ma warstw

Możesz to sprawdzić, umieszczając 'debug.print vLayer ' po for

Czy można dołączyć rysunek + 3D do testów, a także plik swp.

1 polubienie
7

Oto typ pliku, który muszę poprawić za pomocą makra

Czasami nie masz żadnych warstw na starych planach, a nawet plików bez warstw.

W pliku bez warstwy makro nic nie robi.

W pliku z warstwami makro usuwa wszystkie warstwy z wyjątkiem wymiarów, indeks nie jest brany pod uwagę

 


calques.zip
8

Oto typ pliku, który muszę poprawić za pomocą makra

Czasami nie masz żadnych warstw na starych planach, a nawet plików bez warstw.

To na pliku bez warstwy  makro nic nie robi.

W pliku z warstwami makro usuwa wszystkie warstwy z wyjątkiem wymiarów, ale usuwa warstwy indeksu.


calques.zip
9

Usuń  wszystkie warstwy z wyjątkiem wymiaru indeksu .... , makro działa, jeśli warstwa istnieje.

W tej chwili Wskazówka A, Wskazówka B, są usuwane, ten wiersz poleceń nie jest brany pod uwagę

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

 

Zamieniłem na te polecenia, działa.

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

     

         

10

Dziękuję za wczorajszą informację zwrotną Jerome,

Z drugiej strony informacje, których nie wziąłem pod uwagę 

  1. Utwórz warstwy Dimension, IndexA, IndexB...... jeśli ich nie ma.

Czy to możliwe?

11

Dodaj warstwę za pomocą:

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

1 polubienie
12

Witaj Hieronim,

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

, które podałeś mi wczoraj, pokazuje mi błąd

 

Zamieniłem na tę linię

łóżeczko = swLayerMgr.AddLayer("Wymiar", "", RGB(0, 0, 0), 0, 0)

 

Czy istnieje ustawienie umożliwiające aktywowanie określonej warstwy, jeśli na mapie tła nie ma warstwy do przetworzenia?


 

13

Oto makro


maj_calques.swp
14

O ile u mnie popełniłem błąd podczas kopiowania-wklejania to jest:

łóżeczko = swLayerMgr.AddLayer("wymiar", "", 0, swLineStyles_e.swLineCONTINUOUS, swLineWeights_e.swLW_THIN)

 

Czy możesz wyjaśnić pytanie: "czy istnieje parametr aktywujący określoną warstwę, jeśli w planie tła nie ma warstwy do przetworzenia?"

1 polubienie
15

Podczas uruchamiania makra warstwy są tworzone dobrze

Jeśli na przetworzonej warstwie nie ma żadnej warstwy, po zakończeniu przetwarzania makra nie będzie żadnych aktywnych warstw

 Warstwa aktywna to warstwa ze   strzałką  (patrz PC)

Chcę ustawić aktywną warstwę podczas tworzenia warstw za pomocą makra. 

Na przykład  aktywna warstwa rysunkowa

 

 


download.jpeg.jpg
16

Musisz wprowadzić:

swLayerMgr.SetCurrentLayer "Nom_du_calque"

Aby uczynić go aktywnym

1 polubienie