Makro: Dodawanie materiałów + skórek

Witam wszystkich,

Stworzyłem makro, które automatycznie generuje konfiguracje pomieszczeń odpowiadające RAL farby.

W solidworks utworzyłem materiały odpowiadające RAL, umieszczając na nich odpowiednie powiązane wyglądy.

W pomieszczeniu, kiedy ręcznie nakładam i zmieniam materiał, kolory dobrze się różnią w korespondencji.

Dzięki makro konfiguracje są dobrze wykonane, materiały są dobrze zastosowane, a wyglądy dobrze odpowiadają konfiguracjom.

Lecz wszystkie kolory wszystkich konfiguracji są podobne do kolorów pierwszej konfiguracji, a więc do pierwszego pojawienia się

Kiedy edytuję materiał i klikam zastosuj bez wprowadzania jakichkolwiek zmian, wygląd sam się koryguje i zmienia na odpowiedni kolor.

Czy masz jakieś pojęcie o problemie?

Poniżej znajduje się kod:

    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

Witam
Nie zdążyłem jeszcze zajrzeć do tego tematu, jest już taki przykład działania API (w zasadzie "problem" polega na tym, że domyślnie stosuje kolor materiału do wszystkich konfiguracji).
Pobieranie i ustawianie przykładowych właściwości wizualnych materiału (VBA) - 2022 - Pomoc SOLIDWORKS API

1 polubienie

Tak, to jest "problem".
Dobrze stosuje materiały do każdej konfiguracji, ale to wygląd pierwszego materiału jest stosowany do wszystkich konfiguracji. I z tym właśnie mam problem, bo trzeba wracać do każdej konfiguracji, aby ponownie nałożyć odpowiedni materiał.

Witam;

Czy nie powinniśmy tworzyć stanu wyświetlania dla każdej nowej konfiguracji?
Lub pozostawiając zaznaczoną opcję "Połącz stany wyświetlania z konfiguracjami" =>.

gatunku: (Do adaptacji)

Dim swConfig jako SldWorks.Configuration
Dim displayStateNames As Variant

Ustaw swConfig = swModel.GetActiveConfiguration
status = swConfig.CreateDisplayState("NUMER MATERIAU+FARBA")

Pozdrowienia.

1 polubienie

Witam @Maclane
Tak, byłoby prościej, ale nie możemy pracować ze stanami wyświetlania, ponieważ mamy właściwości związane z każdą konfiguracją, które są pobierane z naszych BOM-ów. Musimy więc pracować z konfiguracjami, a więc i związanymi z nimi wyglądami.

Mam problem ze zrozumieniem Twojego rozumowania, tworzenie stanów wyświetlania nie jest niezgodne z używaniem konfiguracji.
Jest to jedyna metoda, jaką znalazłem do tworzenia moich bibliotek części wielomateriałowych ...

1 polubienie

Witam
Na moich plikach jest domyślnie ustawiony z opcją "Połącz stany wyświetlania z konfiguracjami".
Problem nie istnieje, przetestowałem kod, który podlinkowałem, stosuje on odpowiedni wygląd, ale jak wyjaśniono, nie mam czasu na "analizę" tego przykładu, aby zintegrować go z oryginalnym makrem.

Dziękuję za radę @Maclane ,
Sprawdziłem i mam stan wyświetlania według konfiguracji. Mają dobrze powiązane z konfiguracjami.
Chodziło mi o to, że pracujemy tylko z jednym stanem wyświetlania na konfigurację.
Potrzebujemy konfiguracji według koloru, aby istniał kod artykułu dla każdej konfiguracji.
Sam w sobie funkcja makra, ponieważ przypisuje materiały i wyglądy według konfiguracji. Jedynym problemem jest to, że kolor pierwszej konfiguracji dotyczy wszystkich konfiguracji.
Po tym jestem zainteresowany nieco bardziej szczegółowymi wyjaśnieniami na temat twojej metody dla części wielomateriałowych. Nie rozumiem, jak to działa. Dziękuję

Dziękuję @Cyril_f ,
Sprawdziłem i u mnie też stany wyświetlania są powiązane z konfiguracjami.
Zamierzam zagłębić się w kod, który mi wysłałeś, aby spróbować znaleźć rozwiązanie.
Otwieram skrzynkę neuronową i zaczynam...

Witam;

Właśnie zauważyłem, że "swPart.AddConfiguration2" był już przestarzały w 2017 roku???
Zobaczmy, czy zastąpienie go przez AddConfiguration3, skojarzone z "swConfigurationOptions2_e Enumeration" nie rozwiąże problemu.
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

Pozdrowienia.

2 polubienia

Inne drogi do zbadania:

https://help.solidworks.com/2021/English/SolidWorks/sldworks/r_Materials_in_Configurations.htm
… przepraszam, nie mam czasu na testowanie...

2 polubienia

Dziękuję @Maclane ,
Dostosowałem to, co znalazłem na CodeStack i działa cudownie :+1:
I dziękuję wszystkim za odpowiedzi, które pozwoliły mi ruszyć naprzód i zrozumieć trochę więcej na temat VBA

Cieszę się, że byłem pomocny...
Z czego to się wtedy wzięło?
Mile widziane byłoby udostępnienie poprawionego kodu. :roll_eyes:

1 polubienie

Oto część dotycząca ARL:

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: