Macro Appearance Materials

Macro
1

Hello;
Under my Solidworks 2022 I created a macro to be able to reload the appearances (the p2m files) of my materials.
The macro traverses the assemblies and Deletes and Reassigns all appearances of the materials:

Option Explicit

Sub RechargerMatieresDansAssemblage()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swAssembly As SldWorks.AssemblyDoc
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Or swModel.GetType <> swDocASSEMBLY Then
        MsgBox "Ouvrez un assemblage dans SolidWorks.", vbExclamation
        Exit Sub
    End If
    
    Set swAssembly = swModel
    
    ' Lancer la récursion sur tous les composants
    AppelRemontéeComposants swAssembly, Nothing
End Sub

' Fonction récursive pour traiter composants d’un assemblage
Sub AppelRemontéeComposants(asm As SldWorks.AssemblyDoc, parentComp As Object)
    Dim vComp As Variant
    Dim swComp As SldWorks.Component2
    Dim swModel As SldWorks.ModelDoc2
    Dim swPart As SldWorks.PartDoc
    
    vComp = asm.GetComponents(True) ' get tous composants, même cachés
    Dim i As Long
    For i = 0 To UBound(vComp)
        Set swComp = vComp(i)
        
        ' Essayer d’ouvrir le composant si ce n’est pas un sous-assemblage
        On Error Resume Next
        Set swModel = swComp.GetModelDoc2
        On Error GoTo 0
        
        If Not swModel Is Nothing Then
            If swModel.GetType = swDocPART Then
                ' Traiter la pièce
                Call RechargerMateriau(swModel)
            ElseIf swModel.GetType = swDocASSEMBLY Then
                ' Récursivité pour sous-assemblages
                Call AppelRemontéeComposants(swModel, swComp)
            End If
        End If
    Next i
End Sub

' Fonction pour recharger le matériau d’un modèle
Sub RechargerMateriau(swModel As SldWorks.ModelDoc2)
    Dim swPart As SldWorks.PartDoc
    Dim configName As String
    Dim databaseName As String
    Dim materialName As String
    
    Set swPart = swModel
        
If swModel.GetPathName() Like "*Bibl*" Then Exit Sub

    configName = swModel.ConfigurationManager.ActiveConfiguration.Name
    ' Récupérer le matériau actuel
    materialName = swPart.GetMaterialPropertyName2(configName, databaseName)
    
    Debug.Print "Composant en cours de traitement : " & swModel.GetTitle()
    
    If materialName <> "" Then
        ' Désaffecter le matériau puis le réaffecter pour forcer la recharge
        
        swModel.SetMaterialPropertyName2 "", "", ""
    Call swPart.SetMaterialPropertyName2(configName, databaseName, materialName)
        
        ' Rebuild et actualisation
        swModel.EditRebuild3
        swModel.GraphicsRedraw2
        Debug.Print "Matériau rechargé pour : " & swModel.GetPathName()
    End If
End Sub

But (there is always a " but ") on some parts, in addition to the appearance of the base material, an appearance overlay is applied to be able to identify our notions of " as-built " (as-built).
image

In the macro above I couldn't identify the components with these appearances so as not to apply the Material replacement (which will remove these " as-is "), I want to keep them as they are.

Could you help me?

2

Hello

Can you please specify at what level the TQC appearances are affected?

  • Room level? (as a substitute for the appearance of the material)
  • Body-wise?
  • In terms of function?
  • Face level?
  • Component level?
3

The vast majority of as-built appearances are affected at the component level.
Sometimes at the level of the body or a face, but I think it is illusory, at first, to ask the API to " scan " the slightest part of the room in search of these appearances.
I will be content, for the most part, with a check on the component.

4

I think I've found a promising lead:

1 Like
5

Also look at this topic:
https://forum.mycad.visiativ.com/t/api-solidworks-supprimer-enlever-une-apparence-par-son-nom/106764/4
For my part, I had circumvented the problem in another way (by applying to everything from memory)

1 Like
6

Yes, that's it. Here's a quick C# code to put at the beginning of your ReloadMaterial method

            Configuration swConfig = (Configuration)swModel.GetActiveConfiguration();
            object[] displayStateNames = (object[])swConfig.GetDisplayStates();
            object[] b = (object[])swModel.Extension.GetRenderMaterials2(2, displayStateNames);
            foreach (object c in b)
            {
                IRenderMaterial d = c as IRenderMaterial;
                if(d != null)
                {
                    Debug.Print(d.FileName.ToString());
                    if (d.FileName.Contains("TQC"))
                        return;
                }
            }
7

Translation by chatGPT to be adapted and checked of course

Sub CheckRenderMaterials()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swConfig As SldWorks.Configuration
    Dim displayStateNames As Variant
    Dim renderMats As Variant
    Dim vMat As Variant
    Dim swRenderMat As SldWorks.RenderMaterial

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then Exit Sub

    ' Récupère la configuration active
    Set swConfig = swModel.GetActiveConfiguration
    If swConfig Is Nothing Then Exit Sub

    ' Récupère les états d'affichage
    displayStateNames = swConfig.GetDisplayStates

    ' Récupère les matériaux de rendu
    renderMats = swModel.Extension.GetRenderMaterials2(2, displayStateNames)

    ' Parcourt les matériaux
    For Each vMat In renderMats
        Set swRenderMat = vMat
        If Not swRenderMat Is Nothing Then
            Debug.Print swRenderMat.FileName
            If InStr(1, swRenderMat.FileName, "TQC", vbTextCompare) > 0 Then
                Exit Sub ' équivalent de return
            End If
        End If
    Next vMat

End Sub
1 Like
8

Thank you for your participation, but in my case I don't use display states however it opens up other avenues of work.

By relying on the "Delete Appearance Example (VBA)" macro of the Solidworks help, I managed to come up with a macro that seems to meet my needs well.

On the other hand, be indulgent, it is raw from the foundry and you will have to deburr and rebore (professional deformation) some functions and statements to make it more digestible:

Option Explicit

Sub RechargerMatieresDansAssemblage()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swAssembly As SldWorks.AssemblyDoc
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    If swModel Is Nothing Or swModel.GetType <> swDocASSEMBLY Then
        MsgBox "Ouvrez un assemblage dans SolidWorks.", vbExclamation
        Exit Sub
    End If
    
    Set swAssembly = swModel
    
    ' Lancer la récursion sur tous les composants
    AppelRemontéeComposants swAssembly, Nothing
End Sub

' Fonction récursive pour traiter composants d’un assemblage
Sub AppelRemontéeComposants(asm As SldWorks.AssemblyDoc, parentComp As Object)
    Dim vComp As Variant
    Dim swComp As SldWorks.Component2
    Dim swModel As SldWorks.ModelDoc2
    Dim swPart As SldWorks.PartDoc
    
    vComp = asm.GetComponents(True) ' get tous composants, même cachés
    Dim i As Long
    For i = 0 To UBound(vComp)
        Set swComp = vComp(i)
        
        ' Essayer d’ouvrir le composant si ce n’est pas un sous-assemblage
        On Error Resume Next
        Set swModel = swComp.GetModelDoc2
        On Error GoTo 0
        
        If Not swModel Is Nothing Then
            If swModel.GetType = swDocPART Then
                ' Traiter la pièce
                Call RechargerMateriau(swModel)
            ElseIf swModel.GetType = swDocASSEMBLY Then
                ' Récursivité pour sous-assemblages
                Call AppelRemontéeComposants(swModel, swComp)
            End If
        End If
    Next i
End Sub

' Fonction pour recharger le matériau d’un modèle
Sub RechargerMateriau(swModel As SldWorks.ModelDoc2)
    Dim swPart As SldWorks.PartDoc
    Dim configName As String
    Dim databaseName As String
    Dim materialName As String
    
    Set swPart = swModel
        
If UCase(swModel.GetPathName()) Like "*BIBL*" Then Exit Sub

    configName = swModel.ConfigurationManager.ActiveConfiguration.Name
    ' Récupérer le matériau actuel
    materialName = swPart.GetMaterialPropertyName2(configName, databaseName)
    Debug.Print "---------------------------------------------------------------"
    Debug.Print "---------------------------------------------------------------"
    Debug.Print "Composant en cours de traitement : " & swModel.GetTitle()
    
    If materialName <> "" Then
        ' Désaffecter le matériau puis le réaffecter pour forcer la recharge
        
     '*****************************************************************
 'Contrôle de l'apparence au niveau du composant pour eviter de remplacer les apparences "TQC"
 
     ' Get the render materials
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swSelMgr As SldWorks.SelectionMgr
Dim swRenderMaterial As SldWorks.RenderMaterial
Dim varRenderMaterial As Variant
Dim vRenderMaterial As Variant
Dim NomApparence As String
Dim ApparenceCount As Long, ApparenceID As Long
Dim boolstatus As Boolean

Set swSelMgr = swModel.SelectionManager
Set swModelDocExt = swModel.Extension

ApparenceCount = swModelDocExt.GetRenderMaterialsCount
Debug.Print "Quantité d'apparence trouvées: " & ApparenceCount
varRenderMaterial = swModelDocExt.GetRenderMaterials

NomApparence = ""

For Each vRenderMaterial In varRenderMaterial
    Set swRenderMaterial = vRenderMaterial
    ApparenceID = swRenderMaterial.MaterialID
    'Debug.Print "Appearance ID: " & ApparenceID
    NomApparence = swRenderMaterial.FileName
    Debug.Print "Appearance filename: " & NomApparence
    
        If UCase(NomApparence) Like "*TQC*" Then Exit Sub
    
    swModelDocExt.UpdateRenderMaterialsInSceneGraph True
Next

 '*****************************************************************
        swModel.SetMaterialPropertyName2 "", "", ""
    Call swPart.SetMaterialPropertyName2(configName, databaseName, materialName)
        
        ' Rebuild et actualisation
        swModel.EditRebuild3
        swModel.GraphicsRedraw2
        Debug.Print "Matériau rechargé pour : " & swModel.GetPathName()
    End If
End Sub

And this is the only time when I accept the help of AIs to restructure and comment on my macros...

2 Likes