Same part - same colour

[martinhoos]

Hi all,

i am looking for a code that will go through the assembly and will change the colour of each part. But same parts should have the same colour. So it is easy to understand the assembly that is created by an colleague.

thanks in advance

Regards from germany

Martin

[HideoYamada]

Hello from Japan,

Try this code!

Please use freely.

Sub IColor()
    Dim doc As AssemblyDocument
    Dim designView As DesignViewRepresentation
    Dim viewFound As Boolean
    Dim repManager As RepresentationsManager
    
    Set doc = ThisApplication.ActiveDocument
    Set repManager = doc.ComponentDefinition.RepresentationsManager
    
    viewFound = False
    For Each designView In repManager.DesignViewRepresentations
        If designView.Name = "IColor" Then
            viewFound = True
            Exit For
        End If
    Next
    If Not viewFound Then
        Set designView = repManager.DesignViewRepresentations.Add("IColor")
    End If
    designView.Activate
    
    Dim occ As ComponentOccurrence
    Dim index As Integer
    Dim localAsset As Asset
    
    index = 0
    
    For Each occ In doc.ComponentDefinition.Occurrences
        Set localAsset = GetAsset(doc, index)
        occ.Appearance = localAsset
        index = index + 1
        If index = 16 Then
            index = 0
        End If
    Next
End Sub

Private Function GetAsset(doc As AssemblyDocument, colorNumber As Integer) As Asset
    Dim localAsset As Asset
    Dim colorName As String
    
    colorName = "IColor" & colorNumber

    On Error Resume Next
    Set localAsset = doc.Assets.Item(colorName)
    If Err Then
        Set localAsset = doc.Assets.Add(kAssetTypeAppearance, "Generic", colorName, colorName)
        
        Dim tobjs As TransientObjects
        Set tobjs = ThisApplication.TransientObjects
        
        Dim color As ColorAssetValue
        Dim red As Integer
        Dim green As Integer
        Dim blue As Integer
        Dim high As Integer
        Dim low As Integer
        
        If colorNumber < 8 Then
            high = 255
            low = 30
        Else
            high = 127
            low = 0
        End If
        
        If colorNumber And 1 Then
            red = high
        Else
            red = low
        End If
        If colorNumber And 2 Then
            green = high
        Else
            green = low
        End If
        If colorNumber And 4 Then
            blue = high
        Else
            blue = low
        End If
        localAsset.Item("generic_diffuse").Value = tobjs.CreateColor(red, green, blue)
        
        Dim floatValue As FloatAssetValue
        Set floatValue = localAsset.Item("generic_reflectivity_at_0deg")
        floatValue.Value = 0.1
        
        Set floatValue = localAsset.Item("generic_reflectivity_at_90deg")
        floatValue.Value = 0.1
    End If
    On Error GoTo 0

    Set GetAsset = localAsset
End Function

Best Regards,

=====

Freeradical

 Hideo Yamada

[martinhoos]

Hello Hideo Yamada,

thank you very much for the reply. If i run your code, i get colored parts, thats good.

But i did not get the same colour for the same parts.

Regards Martin

[HideoYamada · Accepted solution]

Hello Martin,

Replace IColor() with the following :

Sub IColor()
    Dim doc As AssemblyDocument
    Dim designView As DesignViewRepresentation
    Dim viewFound As Boolean
    Dim repManager As RepresentationsManager
    
    Set doc = ThisApplication.ActiveDocument
    Set repManager = doc.ComponentDefinition.RepresentationsManager
    
    viewFound = False
    For Each designView In repManager.DesignViewRepresentations
        If designView.Name = "IColor" Then
            viewFound = True
            Exit For
        End If
    Next
    If Not viewFound Then
        Set designView = repManager.DesignViewRepresentations.Add("IColor")
    End If
    designView.Activate
    
    Dim occ As ComponentOccurrence
    Dim occ2 As ComponentOccurrence
    Dim index As Integer
    Dim index2 As Integer
    Dim localAsset As Asset
    Dim colorIndex As Integer
    
    colorIndex = 0
    
    For index = 1 To doc.ComponentDefinition.Occurrences.Count
        Set occ = doc.ComponentDefinition.Occurrences(index)
        If Left(occ.Appearance.DisplayName, 6) <> "IColor" Then
            Set localAsset = GetAsset(doc, colorIndex)
            For index2 = index To doc.ComponentDefinition.Occurrences.Count
                Set occ2 = doc.ComponentDefinition.Occurrences(index2)
                If occ.Definition Is occ2.Definition Then
                    occ2.Appearance = localAsset
                End If
            Next index2
            colorIndex = (colorIndex + 1) And 15
        End If
    Next index
End Sub

Does this work fine?

=====

Freeradical

 Hideo Yamada

[martinhoos]

Hello Hideo Yamada,

thank you very much! Your code did exactly what i like to have.

Thanks again and regards to Japan...

Martin