Anwenden eines Farbeffekts auf einen Körper (Makro)

Hallo

Ich möchte ein Material und ein Erscheinungsbild über ein Makro anwenden. Tatsächlich habe ich ein Makro aufgenommen, um eine Hintergrundgeschichte zu haben. Leider wird die Veränderung des Aussehens eines Körpers nicht berücksichtigt. Haben Sie eine Idee für den Code? Ich versuche, das Erscheinungsbild von "transparentem Kunststoff" zu beeinflussen.

Danke für Ihre Hilfe.

Aussehen von "durchscheinendem Kunststoff"

Für mich muss man nur das Material mit der Eigenschaft transparent erstellen und dann das vorhandene Material durch das neue ersetzen.

Einige gefundene Beispiele:

http://help.solidworks.com/2021/English/api/sldworksapi/Set_Material_Example_VB.htm?verRedirect=1

https://r1132100503382-eu1-3dswym.3dexperience.3ds.com/#community:yUw32GbYTEqKdgY7-jbZPg/iquestion:xuqdxleds8qsyxdrksn6ua

Ansonsten habe ich auch dieses Makro in meiner Bibliothek (nicht getestet):

'Cette macro recharge l'une des 3 matières au choix  si détecté dans la pièce

Option Explicit


Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim myMatVisProps As SldWorks.MaterialVisualPropertiesData
Dim orgBlend As Boolean
Dim orgApply As Boolean
Dim orgAngle As Double
Dim orgScale As Double
Dim longstatus As Long
Dim bRet As Boolean
Dim i As Long
Dim Assembly As ModelDoc2
Dim myAssy As AssemblyDoc
Dim myCmps As Variant
Dim myCmp As Component2
Dim nInfo As Long

Sub main()
    Set swApp = Application.SldWorks
    Set Assembly = swApp.ActiveDoc
    Set myAssy = Assembly

    myCmps = myAssy.GetComponents(False)
    For i = 0 To UBound(myCmps)
        Set myCmp = myCmps(i)
        If (myCmp.GetSuppression = 3) Or (myCmp.GetSuppression = 2) Then
            bRet = myCmp.Select2(False, 0)
            bRet = myAssy.EditPart2(True, True, nInfo)
            Set swModel = myAssy.GetEditTarget

            If swModel.GetType = 1 Then
                Dim result As String
                Dim Mat As String
                Dim configName As String
                configName = "Défaut"
                Dim databaseName As String
                'nom de la base des matériaux
                databaseName = "C:/Program Files/SOLIDWORKS Corp/SOLIDWORKS/lang/french/sldmaterials/solidworks materials.sldmat"

                Dim searchPropName1 As String
                Dim searchPropName2 As String
                Dim searchPropName3 As String
                Dim searchPropName4 As String
                'Noms des matériaux à recharger
                searchPropName1 = "Soudure inox"
                searchPropName2 = "Stellite Grade 21 (RC)"
                searchPropName3 = "Stellite Grade 12 (RB)"
                searchPropName4 = "Stellite Grade 6 (RA)"

                Dim myPart As SldWorks.PartDoc
                Set myPart = swModel
                result = myPart.GetMaterialPropertyName2(configName, Mat)

                If result = searchPropName1 Then
                    myPart.SetMaterialPropertyName2 configName, databaseName, searchPropName1
                    Set myMatVisProps = myPart.GetMaterialVisualProperties()
                    Call apply_material_visual_properties(myMatVisProps, myPart)
                ElseIf result = searchPropName2 Then
                    myPart.SetMaterialPropertyName2 configName, databaseName, searchPropName2
                    Set myMatVisProps = myPart.GetMaterialVisualProperties()
                    Call apply_material_visual_properties(myMatVisProps, myPart)
                ElseIf result = searchPropName3 Then
                    myPart.SetMaterialPropertyName2 configName, databaseName, searchPropName3
                    Set myMatVisProps = myPart.GetMaterialVisualProperties()
                    Call apply_material_visual_properties(myMatVisProps, myPart)
                ElseIf result = searchPropName4 Then
                    myPart.SetMaterialPropertyName2 configName, databaseName, searchPropName4
                    Set myMatVisProps = myPart.GetMaterialVisualProperties()
                    Call apply_material_visual_properties(myMatVisProps, myPart)
                End If
            End If

            myAssy.EditAssembly
        End If
    Next i

    Assembly.ForceRebuild3 False

End Sub


Private Sub apply_material_visual_properties(myMatVisProps As SldWorks.MaterialVisualPropertiesData, myPart As SldWorks.PartDoc)
    If Not myMatVisProps Is Nothing Then
        orgAngle = myMatVisProps.Angle
        longstatus = myPart.SetMaterialVisualProperties(myMatVisProps, swThisConfiguration, Nothing)

        orgScale = myMatVisProps.Scale2
        longstatus = myPart.SetMaterialVisualProperties(myMatVisProps, swThisConfiguration, Nothing)

        If myMatVisProps.BlendColor = 0 Then
            orgBlend = False
        Else
            orgBlend = True
        End If
        myMatVisProps.BlendColor = Not orgBlend
        longstatus = myPart.SetMaterialVisualProperties(myMatVisProps, swThisConfiguration, Nothing)
        myMatVisProps.BlendColor = orgBlend
        longstatus = myPart.SetMaterialVisualProperties(myMatVisProps, swThisConfiguration, Nothing)

        If myMatVisProps.ApplyMaterialColorToPart = 0 Then
            orgApply = False
        Else
            orgApply = True
        End If
        myMatVisProps.ApplyMaterialColorToPart = Not orgApply
        longstatus = myPart.SetMaterialVisualProperties(myMatVisProps, swThisConfiguration, Nothing)
        myMatVisProps.ApplyMaterialColorToPart = orgApply
        longstatus = myPart.SetMaterialVisualProperties(myMatVisProps, swThisConfiguration, Nothing)

        If myMatVisProps.ApplyMaterialHatchToSection = 0 Then
            orgApply = False
        Else
            orgApply = True
        End If
        myMatVisProps.ApplyMaterialHatchToSection = Not orgApply
        longstatus = myPart.SetMaterialVisualProperties(myMatVisProps, swThisConfiguration, Nothing)
        myMatVisProps.ApplyMaterialHatchToSection = orgApply
        longstatus = myPart.SetMaterialVisualProperties(myMatVisProps, swThisConfiguration, Nothing)

        If myMatVisProps.ApplyAppearance = 0 Then
            orgApply = False
        Else
            orgApply = True
        End If
        myMatVisProps.ApplyAppearance = Not orgApply
        longstatus = myPart.SetMaterialVisualProperties(myMatVisProps, swThisConfiguration, Nothing)
        myMatVisProps.ApplyAppearance = orgApply
        longstatus = myPart.SetMaterialVisualProperties(myMatVisProps, swThisConfiguration, Nothing)
    End If
End Sub

 

@sbadenis Wie erzeugt man Materie mit der transparenten Eigenschaft?

Folgen Sie den Ratschlägen in diesem Link:

http://help.solidworks.com/2020/French/SolidWorks/sldworks/t_custom_material_creating.htm?verRedirect=1

Oder noch einmal:

https://www.visiativ-solutions.fr/personnaliser-materiau-solidworks/

Dann müssen Sie auf die Registerkarte "Darstellung" gehen und die gewünschten Darstellungen einfügen. (Transparenz)

Oder Sie kopieren ein vorhandenes transparentes Material wie Solidworks-Materialien/Andere Nichtmetalle/Glas (und Sie ändern die Eigenschaften Modul-Elastizität...)

Mehrere Lösungen zur Auswahl.

 

Das Problem ist, dass, egal wie oft ich ein transparentes Material kopiere, sobald ich es umbenenne und seine mechanischen Eigenschaften ändere, die Transparenz verschwindet... Es ist traurig :'( 

Es ist in Ordnung, fand ich, es ist etwas komplizierter als ein Kopieren und Einfügen , aber es funktioniert

Vielen Dank auf jeden Fall für Ihre Antwort