Macro: Materialen + skins toevoegen

Macro
1

Hallo allemaal,

Ik heb een macro gemaakt die automatisch kamerconfiguraties genereert die overeenkomen met verf-RAL's.

In solidworks heb ik de materialen die overeenkomen met de RAL gemaakt door er de juiste bijbehorende verschijningsvormen op te zetten.

In een kamer, wanneer ik het materiaal handmatig aanbreng en verander, variëren de kleuren goed in overeenstemming.

Bij macro zijn de configuraties goed gemaakt, zijn de materialen goed toegepast en komen de looks goed overeen met de configuraties.

Maar de kleuren van alle configuraties lijken allemaal op die van de eerste configuratie, dus van het eerste uiterlijk

Wanneer ik het materiaal bewerk en op toepassen klik zonder iets te veranderen, corrigeert het uiterlijk zichzelf en verandert het in de juiste kleur.

Heb je enig idee van het probleem?

Hieronder vindt u de 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
2

Hallo
Ik heb nog geen tijd gehad om naar dit onderwerp te kijken, er is al een voorbeeld van de API die werkt (in feite heeft het "probleem" te maken met het feit dat het standaard de kleur van het materiaal toepast op alle configuraties).
Voorbeeld van visuele eigenschappen van materiaal ophalen en instellen (VBA) - 2022 - SOLIDWORKS API Help

1 like
3

Ja, dat is het "probleem".
Het past materialen goed toe op elke configuratie, maar het is het uiterlijk van het eerste materiaal dat op alle configuraties wordt toegepast. En dat is waar ik een probleem mee heb, want je moet teruggaan naar elke configuratie om het bijbehorende materiaal opnieuw aan te brengen.

4

Hallo;

Moeten we niet voor elke nieuwe configuratie een weergavestatus maken?
Of door de optie "Weergavestatussen koppelen aan configuraties" => aangevinkt te laten.

van het genre: (Nog aan te passen)

Dim swConfig als SldWorks.Configuration
Dim displayStateNames als variant
…
Set swConfig = swModel.GetActiveConfiguration
status = swConfig.CreateDisplayState("DE MATERIAU+VERF NEE")

Vriendelijke groeten.

1 like
5

Welkom @Maclane
Ja, het zou eenvoudiger zijn, maar we kunnen niet werken met weergavestatussen, omdat we eigenschappen hebben die verband houden met elke configuratie die worden opgehaald uit onze stuklijsten. We moeten dus werken met configuraties en dus gerelateerde verschijningsvormen.

6

Ik heb moeite om je redenering te begrijpen, het maken van weergavestatussen is niet onverenigbaar met het gebruik van configuraties.
Dit is de enige methode die ik heb gevonden om mijn multi-materiaal onderdelenbibliotheken te maken ...

1 like
7

Hallo
Op mijn bestanden is het standaard ingesteld met de optie "Weergavestatussen koppelen aan configuraties".
Het probleem is er niet, ik heb de code getest die ik heb gekoppeld, het past het juiste uiterlijk toe, maar zoals uitgelegd heb ik geen tijd om dit voorbeeld te "ontleden" om het in de originele macro te integreren.

8

Bedankt voor het advies @Maclane ,
Ik heb het gecontroleerd en ik heb een weergavestatus per configuratie. Ze hebben goed betrekking op de configuraties.
Wat ik bedoelde is dat we maar met één weergavestatus per configuratie werken.
We hebben een configuratie op kleur nodig zodat er per configuratie een artikelcode is.
Op zich is de macrofunctie omdat het materialen en verschijningen toewijst op basis van configuratie. Het enige probleem is dat de kleur van de eerste configuratie van toepassing is op alle configuraties.
Daarna ben ik geïnteresseerd in wat meer uitleg over uw methode voor onderdelen uit meerdere materialen. Ik begrijp niet hoe het werkt. Bedankt

9

Dank je wel @Cyril_f ,
Ik heb het nagekeken en ook voor mij zijn de weergavestatussen gekoppeld aan de configuraties.
Ik ga in de code duiken die je me hebt gestuurd om te proberen een oplossing te vinden.
Ik open mijn neurale doos en ik ga aan de slag...

10

Hallo;

Ik heb net gemerkt dat "swPart.AddConfiguration2" al in 2017 is afgeschaft???
Laten we eens kijken of het vervangen door AddConfiguration3, gekoppeld aan "swConfigurationOptions2_e Enumeration" uw probleem niet oplost.
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

Vriendelijke groeten.

2 likes
11

Andere mogelijkheden om te verkennen:

https://help.solidworks.com/2021/English/SolidWorks/sldworks/r_Materials_in_Configurations.htm
… sorry, ik heb geen tijd om te testen...

2 likes
12

Dank je wel @Maclane ,
Ik heb aangepast wat ik op CodeStack heb gevonden en het werkt wonderwel :+1:
En bedankt allemaal voor jullie antwoorden die me in staat stelden om verder te gaan en iets meer over VBA te begrijpen

13

Blij dat ik behulpzaam was...
Waar kwam het dan vandaan?
Het delen van de gecorrigeerde code zou welkom zijn. :roll_eyes:

1 like
14

Hier is het deel over de ARL's:

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: