Community
Inventor Programming - iLogic, Macros, AddIns & Apprentice
Inventor iLogic, Macros, AddIns & Apprentice Forum. Share your knowledge, ask questions, and explore popular Inventor topics related to programming, creating add-ins, macros, working with the API or creating iLogic tools.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Copy color from assembly to parts - 2014 / 2015

3 REPLIES 3
Reply
Message 1 of 4
GeorgK
339 Views, 3 Replies

Copy color from assembly to parts - 2014 / 2015

Hello together,

 

a) how could I copy the color of each part of an assembly to the parts?

b) how could I copy the color from a part to another?

 

Tanky you

 

Georg

3 REPLIES 3
Message 2 of 4
philippe.leefsma
in reply to: GeorgK

Hi Georg,

 

You can get the Appearance asset from the ComponentOccurrence or source Part, and copy it into the target Part using code as follow:

 

Private Sub SetMaterialToPart()

  Dim oDoc As PartDocument
  Set oDoc = ThisApplication.ActiveDocument

  Dim Name As String

  Name = "Copper"
  
  Dim localAsset As Asset

  On Error Resume Next

  Set localAsset = oDoc.Assets.item(Name)

  If Err Then

    On Error GoTo 0

    ' Failed to get the appearance
    ' in the document, so import it.
    ' Get an asset library by name.
    ' Either the displayed name (which
    ' can changed based on the current language)
    ' or the internal name
    ' (which is always the same) can be used.
    Dim assetLib As AssetLibrary
    Set assetLib = ThisApplication.AssetLibraries _
        .item("Autodesk Material Library")

    'Set assetLib = ThisApplication.AssetLibraries _
    '.Item("AD121259-C03E-4A1D-92D8-59A22B4807AD")

    ' Get an asset in the library
    Dim libAsset As Asset
    Set libAsset = assetLib.MaterialAssets.item(Name)

    ' Copy the asset locally.
    Set localAsset = libAsset.CopyTo(oDoc)

  End If

  On Error GoTo 0

  'set material to the part
  oDoc.ActiveMaterial = localAsset

  ' Select the top browser node of the model pane.
  ' This is a workaround to refresh materials info in the UI.
  Call oDoc.BrowserPanes.ActivePane.TopNode.DoSelect

End Sub

Hope that helps,

Philippe.



Philippe Leefsma
Developer Technical Services
Autodesk Developer Network

Message 3 of 4
GeorgK
in reply to: philippe.leefsma

Hello Philippe,

thank you for the code. But I would like to copy only the color and not the material.

Georg
Message 4 of 4
philippe.leefsma
in reply to: GeorgK

If you want it to be compatible with 2014 and 2015, there is no way you can copy just the color, it is part of the material properties. In that case, you could determine which property in the appearance is defining the color and copy that color property in the target appearance.

 

Here is some code that will dump the appearance settings:

 

Public Sub GetAppearanceSettingsToFile()

    Dim doc As PartDocument
    Set doc = ThisApplication.ActiveDocument
    
    Dim appearance As Asset
    'Set appearance = doc.Assets.item("Rot_Transparent")
    Set appearance = doc.ActiveAppearance

    Dim f As Integer
    f = FreeFile()
    Open "C:\Temp\" & appearance.DisplayName & ".txt" For Output As #f

    Print #f, "Appearance Name: " & appearance.DisplayName

    Dim value As AssetValue
    For Each value In appearance
        PrintAssetValueToFile f, value, 5
    Next

    Close #f
    
End Sub

Private Function ColorToString(InColor As color) As String
    ColorToString = "[" & InColor.Red & ", " & InColor.Green & ", " & InColor.Blue & ", " & InColor.Opacity & "]"
End Function

Private Sub PrintAssetValue( _
    ByRef inValue As AssetValue, _
    ByRef indent As Long)
    
    Dim indentChars As String
    indentChars = space(indent)
    
    Debug.Print indentChars & "Value"
    Debug.Print indentChars & "  DisplayName: " & inValue.DisplayName
    Debug.Print indentChars & "  Name: " & inValue.Name
    Debug.Print indentChars & "  IsReadOnly: " & inValue.IsReadOnly
    
    Select Case inValue.ValueType
    
        Case kAssetValueTextureType
        
            Debug.Print indentChars & "  Type: Texture"
            
            Dim textureValue As TextureAssetValue
            Set textureValue = inValue
            
            Dim texture As AssetTexture
            Set texture = textureValue.value
            
            Select Case texture.TextureType
                Case kTextureTypeBitmap
                    Debug.Print indentChars & "  TextureType: kTextureTypeBitmap"
                Case kTextureTypeChecker
                    Debug.Print indentChars & "  TextureType: kTextureTypeChecker"
                Case kTextureTypeGradient
                    Debug.Print indentChars & "  TextureType: kTextureTypeGradient"
                Case kTextureTypeMarble
                    Debug.Print indentChars & "  TextureType: kTextureTypeMarble"
                Case kTextureTypeNoise
                    Debug.Print indentChars & "  TextureType: kTextureTypeNoise"
                Case kTextureTypeSpeckle
                    Debug.Print indentChars & "  TextureType: kTextureTypeSpeckle"
                Case kTextureTypeTile
                    Debug.Print indentChars & "  TextureType: kTextureTypeTile"
                Case kTextureTypeUnknown
                    Debug.Print indentChars & "  TextureType: kTextureTypeUnknown"
                Case kTextureTypeWave
                    Debug.Print indentChars & "  TextureType: kTextureTypeWave"
                Case kTextureTypeWood
                    Debug.Print indentChars & "  TextureType: kTextureTypeWood"
                Case Else
                    Debug.Print indentChars & "  TextureType: Unexpected type returned"
            End Select
            
            Debug.Print indentChars & "  Values"
            Dim textureSubValue As AssetValue
            For Each textureSubValue In texture
                Call PrintAssetValue(textureSubValue, indent + 4)
            Next
            
        Case kAssetValueTypeBoolean
        
            Debug.Print indentChars & "  Type: Boolean"
            
            Dim booleanValue As BooleanAssetValue
            Set booleanValue = inValue
            
            Debug.Print indentChars & "    Value: " & booleanValue.value
            
        Case kAssetValueTypeChoice
            Debug.Print indentChars & "  Type: Choice"
            
            Dim choiceValue As ChoiceAssetValue
            Set choiceValue = inValue
            
            Debug.Print indentChars & "    Value: " & choiceValue.value
            
            Dim names() As String
            Dim choices() As String
            Call choiceValue.GetChoices(names, choices)
            Debug.Print indentChars & "    Choices:"
            
            Dim i As Integer
            For i = 0 To UBound(names)
                Debug.Print indentChars & "      " & names(i) & ", " & choices(i)
            Next
            
        Case kAssetValueTypeColor
        
            Debug.Print indentChars & "  Type: Color"
            
            Dim colorValue As ColorAssetValue
            Set colorValue = inValue
            
            Debug.Print indentChars & "  HasConnectedTexture: " & colorValue.HasConnectedTexture
            Debug.Print indentChars & "  HasMultipleValues: " & colorValue.HasMultipleValues
            
            If Not colorValue.HasMultipleValues Then
                Debug.Print indentChars & "  Color: " & ColorToString(colorValue.value)
            Else
                Debug.Print indentChars & "  Colors"
                
                Dim colors() As color
                colors = colorValue.Values
                
                For i = 0 To UBound(colors)
                    Debug.Print indentChars & "    Color: " & ColorToString(colors(i))
                Next
            End If
            
        Case kAssetValueTypeFilename
            Debug.Print indentChars & "  Type: Filename"
        
            Dim filenameValue As FilenameAssetValue
            Set filenameValue = inValue
            
            Debug.Print indentChars & "    Value: " & filenameValue.value
            
        Case kAssetValueTypeFloat
        
            Debug.Print indentChars & "  Type: Float"
            
            Dim floatValue As FloatAssetValue
            Set floatValue = inValue
            
            Debug.Print indentChars & "    Value: " & floatValue.value
            
        Case kAssetValueTypeInteger
        
            Debug.Print indentChars & "  Type: Integer"
            
            Dim integerValue As IntegerAssetValue
            Set integerValue = inValue
            
            Debug.Print indentChars & "    Value: " & integerValue.value
            
        Case kAssetValueTypeReference
        
            ' This value type is not currently used in any of the assets.
            Debug.Print indentChars & "  Type: Reference"
            
            Dim refType As ReferenceAssetValue
            Set refType = inValue
            
        Case kAssetValueTypeString
            Debug.Print indentChars & "  Type: String"
            
            Dim stringValue As StringAssetValue
            Set stringValue = inValue
            
            Debug.Print indentChars & "    Value: """ & stringValue.value & """"
            
    End Select
End Sub

Private Sub PrintAssetValueToFile( _
    ByRef f As Integer, _
    ByRef inValue As AssetValue, _
    ByRef indent As Long)
    
    Dim indentChars As String
    indentChars = space(indent)
    
    Print #f, indentChars & "Value"
    Print #f, indentChars & "  DisplayName: " & inValue.DisplayName
    Print #f, indentChars & "  Name: " & inValue.Name
    Print #f, indentChars & "  IsReadOnly: " & inValue.IsReadOnly
    
    Select Case inValue.ValueType
    
        Case kAssetValueTextureType
        
            Print #f, indentChars & "  Type: Texture"
            
            Dim textureValue As TextureAssetValue
            Set textureValue = inValue
            
            Dim texture As AssetTexture
            Set texture = textureValue.value
            
            Select Case texture.TextureType
                Case kTextureTypeBitmap
                    Print #f, indentChars & "  TextureType: kTextureTypeBitmap"
                Case kTextureTypeChecker
                    Print #f, indentChars & "  TextureType: kTextureTypeChecker"
                Case kTextureTypeGradient
                    Print #f, indentChars & "  TextureType: kTextureTypeGradient"
                Case kTextureTypeMarble
                    Print #f, indentChars & "  TextureType: kTextureTypeMarble"
                Case kTextureTypeNoise
                    Print #f, indentChars & "  TextureType: kTextureTypeNoise"
                Case kTextureTypeSpeckle
                    Print #f, indentChars & "  TextureType: kTextureTypeSpeckle"
                Case kTextureTypeTile
                    Print #f, indentChars & "  TextureType: kTextureTypeTile"
                Case kTextureTypeUnknown
                    Print #f, indentChars & "  TextureType: kTextureTypeUnknown"
                Case kTextureTypeWave
                    Print #f, indentChars & "  TextureType: kTextureTypeWave"
                Case kTextureTypeWood
                    Print #f, indentChars & "  TextureType: kTextureTypeWood"
                Case Else
                    Print #f, indentChars & "  TextureType: Unexpected type returned"
            End Select
            
            Print #f, indentChars & "  Values"
            Dim textureSubValue As AssetValue
            For Each textureSubValue In texture
                Call PrintAssetValue(textureSubValue, indent + 4)
            Next
            
        Case kAssetValueTypeBoolean
        
            Print #f, indentChars & "  Type: Boolean"
            
            Dim booleanValue As BooleanAssetValue
            Set booleanValue = inValue
            
            Print #f, indentChars & "    Value: " & booleanValue.value
            
        Case kAssetValueTypeChoice
            Print #f, indentChars & "  Type: Choice"
            
            Dim choiceValue As ChoiceAssetValue
            Set choiceValue = inValue
            
            Print #f, indentChars & "    Value: " & choiceValue.value
            
            Dim names() As String
            Dim choices() As String
            Call choiceValue.GetChoices(names, choices)
            Print #f, indentChars & "    Choices:"
            
            Dim i As Integer
            For i = 0 To UBound(names)
                Print #f, indentChars & "      " & names(i) & ", " & choices(i)
            Next
            
        Case kAssetValueTypeColor
        
            Print #f, indentChars & "  Type: Color"
            
            Dim colorValue As ColorAssetValue
            Set colorValue = inValue
            
            Print #f, indentChars & "  HasConnectedTexture: " & colorValue.HasConnectedTexture
            Print #f, indentChars & "  HasMultipleValues: " & colorValue.HasMultipleValues
            
            If Not colorValue.HasMultipleValues Then
                Print #f, indentChars & "  Color: " & ColorToString(colorValue.value)
            Else
                Print #f, indentChars & "  Colors"
                
                Dim colors() As color
                colors = colorValue.Values
                
                For i = 0 To UBound(colors)
                    Print #f, indentChars & "    Color: " & ColorToString(colors(i))
                Next
            End If
            
        Case kAssetValueTypeFilename
            Print #f, indentChars & "  Type: Filename"
        
            Dim filenameValue As FilenameAssetValue
            Set filenameValue = inValue
            
            Print #f, indentChars & "    Value: " & filenameValue.value
            
        Case kAssetValueTypeFloat
        
            Print #f, indentChars & "  Type: Float"
            
            Dim floatValue As FloatAssetValue
            Set floatValue = inValue
            
            Print #f, indentChars & "    Value: " & floatValue.value
            
        Case kAssetValueTypeInteger
        
            Print #f, indentChars & "  Type: Integer"
            
            Dim integerValue As IntegerAssetValue
            Set integerValue = inValue
            
            Print #f, indentChars & "    Value: " & integerValue.value
            
        Case kAssetValueTypeReference
        
            ' This value type is not currently used in any of the assets.
            Print #f, indentChars & "  Type: Reference"
            
            Dim refType As ReferenceAssetValue
            Set refType = inValue
            
        Case kAssetValueTypeString
            Print #f, indentChars & "  Type: String"
            
            Dim stringValue As StringAssetValue
            Set stringValue = inValue
            
            Print #f, indentChars & "    Value: """ & stringValue.value & """"
            
    End Select
End Sub

 Philippe.



Philippe Leefsma
Developer Technical Services
Autodesk Developer Network

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report