Makro: Hinzufügen von Materialien + Skins

Hallo an alle

Ich habe ein Makro erstellt, das automatisch Raumkonfigurationen generiert, die den Farb-RAL entsprechen.

In Solidworks habe ich die Materialien erstellt, die dem RAL entsprechen, indem ich ihnen das richtige zugehörige Aussehen gegeben habe.

Wenn ich in einem Raum das Material manuell auftrage und ändere, variieren die Farben gut in der Korrespondenz.

Mit Makros werden die Konfigurationen gut erstellt, die Materialien sind gut angewendet und das Erscheinungsbild entspricht gut den Konfigurationen.

Aber die Farben aller Konfigurationen sind alle wie die der ersten Konfiguration, also der ersten Erscheinung

Wenn ich das Material bearbeite und auf Anwenden klicke, ohne etwas zu ändern, korrigiert sich das Erscheinungsbild und ändert sich in die richtige Farbe.

Haben Sie eine Vorstellung von dem Problem?

Unten ist der Code:

    Dim swApp                       As SldWorks.SldWorks
    Dim swModel                     As SldWorks.ModelDoc2
    Dim swConfigMgr                 As SldWorks.ConfigurationManager
    Dim swConfig                    As SldWorks.Configuration
    Dim vConfigName                 As Variant
    Dim sSpecConfigNameArr(0)       As String
    Dim vSpecConfigNameArr          As Variant
    Dim dimValue                    As Variant
    Dim stnameConfig                As String
    Dim boolstatus                  As Boolean
    Dim i                           As Integer
    Dim swErrors                    As Long
    Dim swWarnings                  As Long
    Dim swPart                      As SldWorks.PartDoc
    Dim tConfig()                   As String
    Dim swModelDocExt               As ModelDocExtension
    Dim swCustProp                  As CustomPropertyManager
    Dim sMasse                      As String
    Dim sValout                     As String
    Dim sVal                        As String
Sub main()

    '''-----------------------------------------------

    Set swApp = Application.SldWorks
    
    'on récupére le document actif
    Set swModel = swApp.ActiveDoc
    Set swConfigMgr = swModel.ConfigurationManager
    
    'on récupére la configuration active
    Set swConfig = swConfigMgr.ActiveConfiguration
    stnameConfig = swConfig.Name
    vConfigNameArr = swModel.GetConfigurationNames
    
    Set swModelDocExt = swModel.Extension
    
    
    '''-----------------------------------------------
   
   'on boucle sur toutes les configurations
    For Each vConfigName In vConfigNameArr
    'on test si la configuration est différente de la configuration active et de la configuration Default
        
    If vConfigName <> swConfig.Name And vConfigName <> "xx" Then
    boolstatus = swModel.DeleteConfiguration2(vConfigName)
        
    End If
        
    If vConfigName <> swConfig.Name And vConfigName <> "Défaut" Then
    boolstatus = swModel.DeleteConfiguration2(vConfigName)
        
    End If
                    
    Next vConfigName
 
    'on reconstruit la pièces
    swModel.ForceRebuild3 False

Do
    'récupère le document actif dans SW
    Set swModel = swApp.ActiveDoc
    If Not swModel Is Nothing Then
    
        
    ''' lignes déplacées dans la boucle, de manière à ce que l'operation s'effectue sur tous les fichiers et pas juste le premier.

    Set swPart = swModel
    
    
'=> Création de la configuration ALUMINIUM Brut (non peint)
    boolstatus = swPart.AddConfiguration2("00", "", "", True, False, False, True, 256)


    boolstatus = swModel.DeleteConfiguration2("Défaut")
    boolstatus = swModel.DeleteConfiguration2("xx")
    boolstatus = swModel.DeleteConfiguration2("PC")
    
    '''-----------------------------------------------
    
    'Mise en place de la matière
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060"
    
'=> Création des configuration ALUMINIUM Peint (RAL)
    
    boolstatus = swPart.AddConfiguration2("R1013", "", "", True, False, False, True, 256)
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060 - RAL 1013"
    
    boolstatus = swPart.AddConfiguration2("R1018", "", "", True, False, False, True, 256)
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060 - RAL 1018"
    
    boolstatus = swPart.AddConfiguration2("R2008", "", "", True, False, False, True, 256)
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060 - RAL 2008"
    
    boolstatus = swPart.AddConfiguration2("R3000", "", "", True, False, False, True, 256)
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060 - RAL 3000"
    
    boolstatus = swPart.AddConfiguration2("R3004", "", "", True, False, False, True, 256)
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060 - RAL 3004"
    
    boolstatus = swPart.AddConfiguration2("R5015", "", "", True, False, False, True, 256)
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060 - RAL 5015"
    
    boolstatus = swPart.AddConfiguration2("R6005", "", "", True, False, False, True, 256)
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060 - RAL 6005"
    
    boolstatus = swPart.AddConfiguration2("R6018", "", "", True, False, False, True, 256)
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060 - RAL 6018"
    
    boolstatus = swPart.AddConfiguration2("R6029", "", "", True, False, False, True, 256)
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060 - RAL 6029"
    
    boolstatus = swPart.AddConfiguration2("R7016", "", "", True, False, False, True, 256)
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060 - RAL 7016"
    
    boolstatus = swPart.AddConfiguration2("R7035", "", "", True, False, False, True, 256)
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060 - RAL 7035"
    
    boolstatus = swPart.AddConfiguration2("R7037", "", "", True, False, False, True, 256)
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060 - RAL 7037"
    
    boolstatus = swPart.AddConfiguration2("R9005", "", "", True, False, False, True, 256)
    swModel.SetMaterialPropertyName2 "", "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\MATERIAUX\MATERIAUX QUALI-CITE/QUALI-CITE.sldmat", "ALUMINIUM 6060 - RAL 9005"
    
    
    '''----------------------------------------------------------------------------
    
        
    'Enregistre le docuement actif en mode silencieux
    bRet = swModel.Save3(swSaveAsOptions_Silent, swErrors, swWarnings)
    
    'Ferme le document actif
    swApp.CloseDoc swModel.GetPathName
    
End If

'boucle jusqu'a ce qu'il n'y ai plus de fichier ouvert dans SW
Loop While Not swModel Is Nothing

End Sub

Hallo
Ich hatte noch keine Zeit, mir dieses Thema anzusehen, es gibt bereits dieses Beispiel für die Funktionsweise der API (im Grunde hängt das "Problem" mit der Tatsache zusammen, dass standardmäßig die Farbe des Materials auf alle Konfigurationen angewendet wird).
Abrufen und Festlegen von visuellen Materialeigenschaften (VBA) - 2022 - SOLIDWORKS API-Hilfe

1 „Gefällt mir“

Ja, das ist das "Problem".
Es wendet Materialien gut auf jede Konfiguration an, aber es ist das Erscheinungsbild des ersten Materials, das auf alle Konfigurationen angewendet wird. Und damit habe ich ein Problem, weil man zu jeder Konfiguration zurückgehen muss, um das entsprechende Material erneut anzuwenden.

Hallo;

Sollten wir nicht für jede neue Konfiguration einen Anzeigestatus erstellen?
Oder indem Sie die Option "Anzeigezustände mit Konfigurationen verknüpfen" => aktiviert lassen.

des Genres: (Wird noch angepasst)

Dim swConfig als SldWorks.Configuration
Dim displayStateNames als Variante

Legen Sie swConfig = swModel.GetActiveConfiguration fest
status = swConfig.CreateDisplayState("DAS MATERIAU+PAINT NO")

Herzliche Grüße.

1 „Gefällt mir“

Hallo @Maclane
Ja, es wäre einfacher, aber wir können nicht mit Anzeigezuständen arbeiten, da wir Eigenschaften haben, die sich auf jede Konfiguration beziehen, die aus unseren Stücklisten abgerufen werden. Wir müssen also mit Konfigurationen und damit verwandten Erscheinungsbildern arbeiten.

Ich habe Schwierigkeiten, Ihre Argumentation zu verstehen, das Erstellen von Anzeigezuständen ist nicht unvereinbar mit der Verwendung von Konfigurationen.
Dies ist die einzige Methode, die ich gefunden habe, um meine Multimaterial-Bauteilbibliotheken zu erstellen ...

1 „Gefällt mir“

Hallo
Bei meinen Dateien ist es standardmäßig mit der Option "Anzeigezustände mit Konfigurationen verknüpfen" eingestellt.
Das Problem ist nicht da, ich habe den Code getestet, den ich verlinkt habe, er wendet das richtige Erscheinungsbild an, aber wie erklärt, habe ich keine Zeit, dieses Beispiel zu "zerlegen", um es in das ursprüngliche Makro zu integrieren.

Vielen Dank für den Rat @Maclane ,
Ich habe es überprüft und habe einen Anzeigestatus nach Konfiguration. Sie haben sich gut auf die Konfigurationen bezogen.
Was ich meinte ist, dass wir nur mit einem Anzeigezustand pro Konfiguration arbeiten.
Wir benötigen eine Konfiguration nach Farbe, damit es pro Konfiguration einen Artikelcode gibt.
An sich die Makrofunktion, weil sie Materialien und Erscheinungsbilder durch Konfiguration zuweist. Das einzige Problem ist, dass die Farbe der ersten Konfiguration für alle Konfigurationen gilt.
Danach bin ich an einer weiteren Erklärung Ihrer Methode für Multimaterialteile interessiert. Ich verstehe nicht, wie das funktioniert. Vielen Dank

Vielen Dank @Cyril.f ,
Ich habe nachgeschaut und auch bei mir sind die Anzeigezustände mit den Konfigurationen verknüpft.
Ich werde in den Code eintauchen, den Sie mir geschickt haben, um eine Lösung zu finden.
Ich öffne meine neuronale Box und lege los...

Hallo;

Mir ist gerade aufgefallen, dass "swPart.AddConfiguration2" bereits 2017 veraltet war???
Sehen wir uns an, ob das Ersetzen durch AddConfiguration3, das mit "swConfigurationOptions2_e Enumeration" verknüpft ist, Ihr Problem nicht löst.
https://help.solidworks.com/2017/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.imodeldoc2~addconfiguration3.html
https://help.solidworks.com/2017/english/api/swconst/SOLIDWORKS.Interop.swconst~SOLIDWORKS.Interop.swconst.swConfigurationOptions2_e.html

Herzliche Grüße.

2 „Gefällt mir“

Weitere Möglichkeiten, die es zu erkunden gilt:

https://help.solidworks.com/2021/English/SolidWorks/sldworks/r_Materials_in_Configurations.htm
… Entschuldigung, ich habe keine Zeit zum Testen...

2 „Gefällt mir“

Vielen Dank @Maclane ,
Ich habe angepasst, was ich auf CodeStack gefunden habe, und es funktioniert wunderbar :+1:
Und ich danke Ihnen allen für Ihre Antworten, die es mir ermöglicht haben, voranzukommen und ein wenig mehr über VBA zu verstehen

Schön, dass ich hilfsbereit war...
Woher kam es dann?
Eine Weitergabe des korrigierten Codes wäre willkommen. :roll_eyes:

1 „Gefällt mir“

Hier ist der Teil, der sich auf die ARLs bezieht:

Type ConfigData
    MaterialFilePath    As String
    ConfigNameSuffix    As String
    colorName           As String
    
End Type

Const PRP_NAME          As String = "DESIGNATION 2"

Dim swApp As SldWorks.SldWorks

Sub main()
    
    Dim CONFIGS_DATA(4) As ConfigData

    CONFIGS_DATA(0).colorName = "ALUMINIUM BRUT"
    CONFIGS_DATA(0).ConfigNameSuffix = "-00"
    CONFIGS_DATA(0).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\APPARENCES\alu inox.p2m"

    CONFIGS_DATA(1).colorName = "RAL 1013"
    CONFIGS_DATA(1).ConfigNameSuffix = "-R1013"
    CONFIGS_DATA(1).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 1013 mat.p2m"

    CONFIGS_DATA(2).colorName = "RAL 1018"
    CONFIGS_DATA(2).ConfigNameSuffix = "-R1018"
    CONFIGS_DATA(2).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 1018 mat.p2m"

    CONFIGS_DATA(3).colorName = "RAL 2008"
    CONFIGS_DATA(3).ConfigNameSuffix = "-R2008"
    CONFIGS_DATA(3).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 2008 mat.p2m"

    CONFIGS_DATA(4).colorName = "RAL 3000"
    CONFIGS_DATA(4).ConfigNameSuffix = "-R3000"
    CONFIGS_DATA(4).MaterialFilePath = "X:\DONNEES BE\DAO\BUREAU ETUDES\BIBLI SOLIDWORKS\PEINTURE RAL\PE-TEXTURÉE\ral 3000 mat.p2m"

    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    
    Set swModel = swApp.ActiveDoc
    
    Dim i As Integer
    
    For i = 0 To UBound(CONFIGS_DATA)
        
        Dim confName As String
        
        confName = GetFileNameWithoutExtension(swModel.GetPathName())
        
        If CONFIGS_DATA(i).ConfigNameSuffix <> "" Then
            confName = confName & CONFIGS_DATA(i).ConfigNameSuffix
        End If
        
        If i <> 0 Then
            swModel.AddConfiguration3 confName, "", "", 0
        End If
        
        swModel.ConfigurationManager.ActiveConfiguration.Name = confName
        
        If CONFIGS_DATA(i).MaterialFilePath <> "" Then
            AddRenderMaterial swModel, CONFIGS_DATA(i).MaterialFilePath
        End If
        
        AddConfigProperty swModel, CONFIGS_DATA(i).colorName
        
    Next

End Sub

Sub AddRenderMaterial(model As SldWorks.ModelDoc2, path As String)
    
    Dim swRenderMaterial As SldWorks.RenderMaterial
    Set swRenderMaterial = model.Extension.CreateRenderMaterial(path)
    
    If False <> swRenderMaterial.AddEntity(model) Then
        If False = model.Extension.AddDisplayStateSpecificRenderMaterial(swRenderMaterial, swDisplayStateOpts_e.swThisDisplayState, Empty, -1, -1) Then
            Err.Raise vbError, "", "Failed to apply render material to display state"
        End If
    Else
        Err.Raise vbError, "", "Failed to add model as entity to render material"
    End If
   
End Sub

Sub AddConfigProperty(model As SldWorks.ModelDoc2, colorName As String)
    
    Dim swCustPrpMgr As SldWorks.CustomPropertyManager
    
    Set swCustPrpMgr = model.Extension.CustomPropertyManager("")
    
    Dim prpVal As String
    
    swCustPrpMgr.Get4 PRP_NAME, False, "", prpVal
    
    Set swCustPrpMgr = model.ConfigurationManager.ActiveConfiguration.CustomPropertyManager
    
    swCustPrpMgr.Add3 PRP_NAME, swCustomInfoType_e.swCustomInfoText, prpVal & colorName, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue

End Sub

Function GetFileNameWithoutExtension(filePath As String) As String
    GetFileNameWithoutExtension = Mid(filePath, InStrRev(filePath, "\") + 1, InStrRev(filePath, ".") - InStrRev(filePath, "\") - 1)
    
End Function

:+1: