Appliquer, grâce à une macro, des couleurs aux fonctions dans un état d'affichage

Macro
1

Le but de la macro est de créer un état d’affichage nommé « Couleur mise en plan » et d’y appliquer des couleurs spécifiques aux différentes fonctions, par exemple : chambrage en rouge, taraudage en bleu, chanfrein en jaune, etc. Actuellement, la macro fonctionne plutôt bien, mais les couleurs sont appliquées à l’ensemble de la pièce, y compris dans l’état d’affichage par défaut, au lieu d’être limitées à l’état « Couleur mise en plan ».
Si quelqu’un a une idée de comment brider l’application des couleurs.

Option Explicit

Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swDoc As SldWorks.ModelDoc2
    Dim swConfig As SldWorks.Configuration
    Dim swFeat As SldWorks.Feature
    Dim boolstatus As Boolean
    Dim vMatVal(8) As Double
    Dim targetConfigName As String
    Dim displayStateName As String
    
    targetConfigName = "Défaut" ' Configuration principale
    displayStateName = "Couleur mise en plan"
    
    Set swApp = Application.SldWorks
    Set swDoc = swApp.ActiveDoc
    
    If swDoc Is Nothing Then
        MsgBox "Aucun document actif.", vbExclamation
        Exit Sub
    End If
    
    If swDoc.GetType <> swDocPART Then
        MsgBox "Cette macro fonctionne uniquement sur les pièces.", vbExclamation
        Exit Sub
    End If
    
    ' === 1. Vérifier la configuration ===
    Set swConfig = swDoc.GetConfigurationByName(targetConfigName)
    If swConfig Is Nothing Then
        MsgBox "La configuration '" & targetConfigName & "' n'existe pas.", vbExclamation
        Exit Sub
    End If
    
    ' === 2. Vérifier/créer l'état d'affichage ===
    Dim vDisplayStates As Variant
    vDisplayStates = swConfig.GetDisplayStates
    
    Dim stateExists As Boolean
    stateExists = False
    Dim i As Integer
    
    If Not IsEmpty(vDisplayStates) Then
        For i = 0 To UBound(vDisplayStates)
            If LCase(vDisplayStates(i)) = LCase(displayStateName) Then
                stateExists = True
                Exit For
            End If
        Next i
    End If
    
    If Not stateExists Then
        boolstatus = swConfig.CreateDisplayState(displayStateName)
        If boolstatus = False Then
            MsgBox "Impossible de créer l'état d'affichage '" & displayStateName & "'.", vbCritical
            Exit Sub
        End If
    End If
    
    ' === 3. Appliquer les couleurs UNIQUEMENT à cet état ===
    swDoc.ClearSelection2 True
    Set swFeat = swDoc.FirstFeature
    
    While Not swFeat Is Nothing
        Dim featName As String, featType As String
        featName = LCase(swFeat.name)
        featType = LCase(swFeat.GetTypeName2)
        
        Select Case True
            Case featType = "holewzd"
                HandleHoleWizard swFeat, vMatVal, displayStateName
            
            Case InStr(featName, "enlèv. mat") > 0
                SetColorArray vMatVal, RGB(255, 0, 0)
                ColorFaces swFeat, vMatVal, displayStateName
            
            Case InStr(featName, "chanfrein") > 0
                SetColorArray vMatVal, RGB(255, 255, 0)
                ColorFaces swFeat, vMatVal, displayStateName
            
            Case InStr(featName, "symétrie") > 0 Or InStr(featName, "miroir") > 0
                SetColorArray vMatVal, RGB(0, 255, 255)
                ColorFaces swFeat, vMatVal, displayStateName
        End Select
        
        Set swFeat = swFeat.GetNextFeature()
    Wend
    
    ' === 4. Reconstruction finale ===
    swDoc.ForceRebuild3 False
    swDoc.GraphicsRedraw2
    
    MsgBox "Couleurs appliquées uniquement à l'état '" & displayStateName & "'.", vbInformation
End Sub

' Gestion des trous (Hole Wizard)
Sub HandleHoleWizard(ByVal feat As SldWorks.Feature, ByRef vMatVal() As Double, ByVal displayStateName As String)
    Dim name As String
    name = LCase(feat.name)
    
    If InStr(name, "chambrage") > 0 Or InStr(name, "dégagement") > 0 Or InStr(name, "fraisage") > 0 Then
        SetColorArray vMatVal, RGB(255, 0, 0)
        ColorFaces feat, vMatVal, displayStateName
    ElseIf InStr(name, "centrage") > 0 Then
        SetColorArray vMatVal, RGB(0, 255, 0)
        ColorFaces feat, vMatVal, displayStateName
    Else
        SetColorArray vMatVal, RGB(0, 0, 255)
        feat.SetMaterialPropertyValues2 vMatVal, 2, displayStateName ' 2 = swSpecifyDisplayState
    End If
End Sub

' Appliquer couleur aux faces
Sub ColorFaces(ByVal feat As SldWorks.Feature, ByRef colorArr() As Double, ByVal displayStateName As String)
    Dim vFaces As Variant, swFace As SldWorks.Face2
    vFaces = feat.GetFaces
    If Not IsEmpty(vFaces) Then
        Dim i As Integer
        For i = 0 To UBound(vFaces)
            Set swFace = vFaces(i)
            swFace.SetMaterialPropertyValues2 colorArr, 2, displayStateName ' 2 = swSpecifyDisplayState
        Next i
    End If
End Sub

' Préparer tableau couleur
Sub SetColorArray(ByRef arr() As Double, ByVal colorValue As Long)
    arr(0) = (colorValue And &HFF) / 255#
    arr(1) = ((colorValue And &HFF00) \ &H100) / 255#
    arr(2) = ((colorValue And &HFF0000) \ &H10000) / 255#
    arr(3) = 1
    arr(4) = 1
    arr(5) = 0.5
    arr(6) = 0.3125
    arr(7) = 0
    arr(8) = 0
End Sub