Change the color of a component return black grafics

Hi!

I’m trying to change the color of the components of an assembly with a VBA macro.

Searching online I saw two ways to change the color of a component:

  1. using the method MaterialPropertyValues
  2. using GetDisplayStateSetting and DisplayStateSpecMaterialPropertyValues as shown here

I wonder what are the main differences between the two and if there are any pro or cons using one method or the other.

Furthermore if I use the second method, even with the example from the SolidWorks API Help, the changed component appears black unless the component is closed and re-opened or the appearance is changed from the UI. I saw others complaining about this behavior:

Any idea or suggestion?

Thanks in advance.

I reported a bug recently that sounds like what you’re seeing. Here’s what I reported:

As it turns out, the Shininess parameter in SetMaterialPropertyValues2 does not do what it says in the documentation.
SetMaterialPropertyValues2 Method (IComponent2) - 2022 - SOLIDWORKS API Help

From the input values for Shininess that I have tried, the formula does not equal “shininess = 1- Specular spread”. It’s looks like “Specular spread = 0.001 / shininess” or the other way around "shininess = 0.001 / Specular spread ". So it’s a factor 1000 off and there is a division, not a minus, used in the equation.

1 Like

Thank you for the replay, I will try what you suggest.

Meanwhile I settled to use MaterialPropertyValues, I saw no major drawbacks.

In case anyone is interested, here the code of a macro that, on the active assembly:

  • unlink the display states from the configuration
  • delete all display states except the ones defined in DEFAULT_DS and RAND_COLOR_DS
  • in the display state RAND_COLOR_DS set random colors for each component, giving all the instances of the same component the same color
' PurgeDisplayState
'
' Delete display states (DS) in the active file except the one defined in DEFAULT_DS and RAND_COLOR_DS, set random color for components in RAND_COLOR_DS

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2

' Display states to preserve
Const DEFAULT_DS As String = "Default_Display state-1"
Const RAND_COLOR_DS As String = "COLORS"

Dim vMatProp As Variant

Type BomPosition
    model As SldWorks.ModelDoc2
    comp As SldWorks.Component2
    ModelPath As String
    Configuration As String
    Quantity As Double
    Description As String
    Price As Double
End Type

Sub main()

    Set swApp = Application.SldWorks

try_:
    ' Comment the line below to avoid error to exit the macro, for debug only
    On Error GoTo catch_
    Set swModel = swApp.ActiveDoc

    ' Check if the open file is an assembly and it is saved
    If swModel Is Nothing Then
        Err.Raise vbError, "", "Open an assembly to run the macro" ' Open an assembly to run the macro
    End If
    
    If swModel.GetPathName() = "" Then
        Err.Raise vbError, "", "Save the document to run the macro" ' Save the document to run the macro
    End If
    
    If Not swModel.GetType() = swDocumentTypes_e.swDocASSEMBLY Then
        Err.Raise vbError, "", "Open an assembly to run the macro" ' Open an assembly to run the macro
    End If

    vMatProp = swModel.MaterialPropertyValues

    Dim swAssy As SldWorks.AssemblyDoc
    Set swAssy = swApp.ActiveDoc

    swAssy.ResolveAllLightWeightComponents True

    ' Unlink display states from configuration
    Dim swConfigMgr As SldWorks.ConfigurationManager
    Set swConfigMgr = swModel.ConfigurationManager
    swConfigMgr.LinkDisplayStatesToConfigurations = False

    Dim vConfs As Variant
    vConfs = swModel.GetConfigurationNames

    ' Get the active configuration of the file
    Dim activeConfig As Configuration
    Set activeConfig = swConfigMgr.ActiveConfiguration

    ' Check if default and random display state exists
    Dim i As Integer
    Dim defaultFound As Boolean
    defaultFound = False
    Dim randomFound As Boolean
    randomFound = False

    Dim confName As String
    confName = activeConfig.Name

    Dim swConf As SldWorks.Configuration
    Set swConf = swModel.GetConfigurationByName(confName)

    Dim vDispStates As Variant
    vDispStates = swConf.GetDisplayStates

    Dim j As Integer

    For j = 0 To UBound(vDispStates)

        Dim dispStateName As String
        dispStateName = vDispStates(j)

        If dispStateName = DEFAULT_DS Then
            defaultFound = True
        End If

        If dispStateName = RAND_COLOR_DS Then
            randomFound = True
        End If

    Next

    Dim retValue As Boolean
    
    ' Crete default display state
    If defaultFound = False Then
        retValue = activeConfig.CreateDisplayState(DEFAULT_DS)
    End If
    
    ' Create random color display state
    If randomFound = False Then
        retValue = activeConfig.CreateDisplayState(RAND_COLOR_DS)
    End If

    ' Delete unnecessary display states
    vDispStates = swConf.GetDisplayStates

    For j = 0 To UBound(vDispStates)

        dispStateName = vDispStates(j)

        If Not (dispStateName = DEFAULT_DS) And Not (dispStateName = RAND_COLOR_DS) Then
            retValue = swConf.DeleteDisplayState(dispStateName)
        End If

    Next

    ' Set current display state as random color
    swConf.ApplyDisplayState RAND_COLOR_DS

    'Get flat bom
    Dim bom() As BomPosition
    bom = GetFlatBom(swAssy)

    ' Apply random color to component in flat bom
    RandomColor bom, swModel

    Dim View As SldWorks.ModelView
    Set View = swModel.ActiveView
    Dim rect As Variant
    Set rect = Nothing
    View.GraphicsRedraw (rect)

    MsgBox "Macro completed"

    GoTo finally_

catch_:
    MsgBox Err.Description, vbCritical, "Purge display state"

finally_:

End Sub

Function GetFlatBom(assy As SldWorks.AssemblyDoc) As BomPosition()
    
    Dim bom() As BomPosition
        
    Dim vComps As Variant
    vComps = assy.GetComponents(False)
    
    Dim i As Integer
    
    For i = 0 To UBound(vComps)
        
        Dim swComp As SldWorks.Component2
        Set swComp = vComps(i)
        
        If swComp.GetSuppression() <> swComponentSuppressionState_e.swComponentSuppressed And Not swComp.ExcludeFromBOM Then
            
            Dim bomPos As Integer
            bomPos = FindBomPosition(bom, swComp)
            
            If bomPos = -1 Then
                
                If (Not bom) = -1 Then
                    ReDim bom(0)
                Else
                    ReDim Preserve bom(UBound(bom) + 1)
                End If
                                
                bomPos = UBound(bom)

                Set bom(bomPos).model = swComp.GetModelDoc2
                Set bom(bomPos).comp = swComp
                
                bom(bomPos).ModelPath = swComp.GetPathName()
                bom(bomPos).Configuration = swComp.ReferencedConfiguration
                bom(bomPos).Quantity = 1
                
                GetProperties swComp, bom(bomPos).Description, bom(bomPos).Price
                
            Else
                bom(bomPos).Quantity = bom(bomPos).Quantity + 1
            End If
            
        End If
        
    Next
    
    GetFlatBom = bom
    
End Function

Function FindBomPosition(bom() As BomPosition, comp As SldWorks.Component2) As Integer
    
    FindBomPosition = -1
    
    If (Not bom) <> -1 Then
        Dim i As Integer
    
        For i = 0 To UBound(bom)
            If LCase(bom(i).ModelPath) = LCase(comp.GetPathName()) And LCase(bom(i).Configuration) = LCase(comp.ReferencedConfiguration) Then
                FindBomPosition = i
                Exit Function
            End If
        Next
    End If
    
End Function

Sub GetProperties(comp As SldWorks.Component2, ByRef desc As String, ByRef prc As Double)
    
    Dim swCompModel As SldWorks.ModelDoc2
    Set swCompModel = comp.GetModelDoc2()
    
    If swCompModel Is Nothing Then
        Err.Raise vbError, "", "Failed to get model from the component"
    End If
    
    desc = GetPropertyValue(swCompModel, comp.ReferencedConfiguration, "Description")
        
    Dim prcTxt As String
    prcTxt = GetPropertyValue(swCompModel, comp.ReferencedConfiguration, "Price")
    
    If prcTxt <> "" Then
        prc = CDbl(prcTxt)
    End If
    
End Sub

Function GetPropertyValue(model As SldWorks.ModelDoc2, conf As String, prpName As String) As String
    
    Dim confSpecPrpMgr As SldWorks.CustomPropertyManager
    Dim genPrpMgr As SldWorks.CustomPropertyManager
    
    Set confSpecPrpMgr = model.Extension.CustomPropertyManager(conf)
    Set genPrpMgr = model.Extension.CustomPropertyManager("")
    
    Dim prpVal As String
    Dim prpResVal As String
    
    confSpecPrpMgr.Get3 prpName, False, "", prpVal
    
    If prpVal = "" Then
        genPrpMgr.Get3 prpName, False, prpVal, prpResVal
    End If
    
    GetPropertyValue = prpResVal
    
End Function

Sub RandomColor(bom() As BomPosition, swModel As SldWorks.ModelDoc2)

    ' Variable declaration
    Dim swModelDocExt As SldWorks.ModelDocExtension
    Dim swDisplayStateSetting As SldWorks.DisplayStateSetting
    Dim swAppearanceSetting As SldWorks.AppearanceSetting

    ' Get model display property and set display settings
    Set swModelDocExt = swModel.Extension
    Set swDisplayStateSetting = swModelDocExt.GetDisplayStateSetting(swThisDisplayState)
    swDisplayStateSetting.Option = swThisDisplayState
    swDisplayStateSetting.PartLevel = False

    ' Get assembly component, with repetition
    Dim swAssembly As SldWorks.AssemblyDoc
    Set swAssembly = swModel
    Dim vElementArr As Variant
    vElementArr = swAssembly.GetComponents(True)

    Dim swSelMgr As SldWorks.SelectionMgr
    Set swSelMgr = swModel.SelectionManager

    Dim swSelData As SldWorks.SelectData
    Set swSelData = swSelMgr.CreateSelectData

    Dim bRet As Boolean
    Dim i As Integer
    Dim j As Integer
        
    For i = 0 To UBound(bom)

        bRet = bom(i).comp.Select4(False, swSelData, False)

        Randomize
        vMatProp(0) = Rnd 'Red
        vMatProp(1) = Rnd 'Green
        vMatProp(2) = Rnd 'Blue
        vMatProp(3) = Rnd / 2 + 0.5 'Ambient
        vMatProp(4) = Rnd / 2 + 0.5 'Diffuse
        vMatProp(5) = Rnd 'Specular
        vMatProp(6) = Rnd * 0.9 + 0.1 'Shininess

        bom(i).comp.MaterialPropertyValues = vMatProp

        ' Change color for the components with the same filename
        For j = 0 To UBound(vElementArr)

            ' Check if component is suppressed
            Dim swArrComponent As SldWorks.Component2
            Set swArrComponent = vElementArr(j)

            If Not swArrComponent.GetSuppression2 = swComponentSuppressed Then

                If bom(i).model.GetPathName = vElementArr(j).GetModelDoc2.GetPathName Then

                    bRet = vElementArr(j).Select4(True, swSelData, False)
                    vElementArr(j).MaterialPropertyValues = vMatProp

                End If

            End If

        Next

        Set swSelData = swSelMgr.CreateSelectData
    Next

    'Redraw to see new color
    swModel.GraphicsRedraw2
    
End Sub

Some reference material:

1 Like