How do I change the color of a solid in a multibodied part?

[Anonymous]

I have this code Public Sub ChangeSBColor(sbPart As SurfaceBody, strColor As String) Dim appAsset As Asset Dim oLib As AssetLibrary Dim assAssets As Assets Dim oPartDoc As PartDocument Dim oCompOcc As ComponentOccurrenceProxy Set oCompOcc = sbPart.Parent Set oPartDoc = oCompOcc.Definition.Document 'Set appAsset = oPartDoc.AppearanceAssets.Item(strColor) Set oLib = ThisApplication.AssetLibraries("Inventor Material Library") Set appAsset = oLib.AppearanceAssets(strColor) ' Set sbPart.Appearance(1) = appAsset sbPart.Appearance = appAsset ' Set sbPart.Appearance = appAsset End Sub I'm trying to change the color of one solid in a multi-bodied part. However I get an error w/ any of the ways I've tried to assign the color. What gives?

[ekinsb]

Below is some VBA code that accomplishes what you want.  You had some confusion between a body and a component occurrence.  Another thing not obvious is that to assign an appearance to a body, the appearance needs to exist in the document, which means first copying it from the library into the document.  This happens automatically through the UI but in the API you need to take care of it.

Public Sub TestAppearanceChange()
    Dim partDoc As PartDocument
    Set partDoc = ThisApplication.ActiveDocument
    
    Dim oBody As SurfaceBody
    Set oBody = partDoc.ComponentDefinition.SurfaceBodies.Item(1)
    
    Call ChangeSBColor(oBody, "Gold")
End Sub


Public Sub ChangeSBColor(body As SurfaceBody, strColor As String)
    Dim appAsset As Asset
    Dim oLib As AssetLibrary
    Dim assAssets As Assets
    
    ' Get the parent part document.
    Dim partDoc As PartDocument
    Set partDoc = body.Parent.Document
    
    ' Get a spsecific appearance in a library.
    Set oLib = ThisApplication.AssetLibraries("Inventor Material Library")
    Set appAsset = oLib.AppearanceAssets(strColor)
    
    ' Copy the library into the document.
    Dim docAsset As Asset
    Set docAsset = appAsset.CopyTo(partDoc, False)
    
    ' Set the appeareance on the body.
    body.Appearance = docAsset
End Sub

[Anonymous]

I do apologize for the formatting, the preview looked fine.

[Anonymous]

Option Explicit
    Dim assyDoc As AssemblyDocument
    Dim assyDef As AssemblyComponentDefinition
    Dim baseOcc As ComponentOccurrence

Public Sub AddAndCut()
    Dim oPart1 As ComponentOccurrence
    Dim oPart2 As ComponentOccurrence
    Dim oPart3 As ComponentOccurrence
    
    Call PickObject(oPart1, "Pick part to analyze")
    Call PickObject(oPart2, "Pick interference")
    Call PickObject(oPart3, "Pick caution")
    
    If oPart1 Is Nothing Or oPart2 Is Nothing Or oPart3 Is Nothing Then
        MsgBox ("One or more solids not selected")
        Exit Sub
    Else
        If oPart1.DefinitionDocumentType = kAssemblyDocumentObject Then
            Dim ocParts As ComponentOccurrence
            For Each ocParts In oPart1.SubOccurrences
                Call AddObjects(ocParts, oPart2, oPart3)
            Next ocParts
        ElseIf oPart1.DefinitionDocumentType = kPartDocumentObject Then
            Call AddObjects(oPart1, oPart2, oPart3)
        End If
    End If
    
End Sub
Public Sub PickObject(oPart As ComponentOccurrence, strMessage As String)
    Set oPart = ThisApplication.CommandManager.Pick(kAssemblyLeafOccurrenceFilter, strMessage)
    If (oPart Is Nothing) Then Exit Sub
    Debug.Print oPart.Definition.Document.FullFileName
End Sub
Public Sub AddObjects(coBase As ComponentOccurrence, coInt As ComponentOccurrence, coCaution As ComponentOccurrence)
    
    Dim sbInt As SurfaceBody
    Dim sbIntID As Long
    Set assyDoc = ThisApplication.ActiveDocument
    Dim cobaseDef As PartComponentDefinition

    If Not (coBase.Name = coCaution.Name) And Not (coBase.Name = coInt.Name) Then
        Call AssociativeBodyCopy(coBase, coInt)
        sbIntID = coBase.SurfaceBodies.Count

        Set sbInt = coBase.SurfaceBodies.Item(sbIntID)
        sbInt.Name = "Int"
        
        Call ChangeSBColor(sbInt, "Red")
        
        Call AssociativeBodyCopy(coBase, coCaution)
        sbIntID = coBase.SurfaceBodies.Count
        Set sbInt = coBase.SurfaceBodies.Item(sbIntID)
        sbInt.Name = "Caut"
        
        Call ChangeSBColor(sbInt, "Blue - Wall Paint - Glossy")
        
    End If

End Sub


Sub AssociativeBodyCopy(oOccurrence1 As ComponentOccurrence, oOccurrence2 As ComponentOccurrence)

    Dim oPartDef1 As PartComponentDefinition
    Set oPartDef1 = oOccurrence1.Definition

    Dim oPartDef2 As PartComponentDefinition
    Set oPartDef2 = oOccurrence2.Definition

    ' Get the source solid body from the first part.
    Dim oSourceBody As SurfaceBody
    Set oSourceBody = oPartDef2.SurfaceBodies.Item(1)

    Dim oSourceBodyProxy As SurfaceBodyProxy
    Call oOccurrence2.CreateGeometryProxy(oSourceBody, oSourceBodyProxy)

    ' Create an associative surface base feature in the second part.
    Dim oFeatureDef1 As NonParametricBaseFeatureDefinition
    Set oFeatureDef1 = oPartDef1.Features.NonParametricBaseFeatures.CreateDefinition

    Dim oCollection As ObjectCollection
    Set oCollection = ThisApplication.TransientObjects.CreateObjectCollection

    oCollection.Add oSourceBodyProxy

    oFeatureDef1.BRepEntities = oCollection
    oFeatureDef1.OutputType = kSurfaceOutputType
    oFeatureDef1.TargetOccurrence = oOccurrence1
    oFeatureDef1.IsAssociative = True

    Dim oBaseFeature1 As NonParametricBaseFeature
    Set oBaseFeature1 = oPartDef1.Features.NonParametricBaseFeatures.AddByDefinition(oFeatureDef1)
    
    Dim wsInt As WorkSurface
    Dim wsIntID As Long
    wsIntID = oPartDef1.WorkSurfaces.Count
    Set wsInt = oPartDef1.WorkSurfaces.Item(wsIntID)
    
    Call SculptSurface(wsInt, oPartDef1)
    
    assyDoc.Update
End Sub

Public Sub SculptSurface(wsSurf2Sculpt As WorkSurface, ptBasePart As PartComponentDefinition)

    Dim ptfeatSculpt As PartFeature
    Dim ptFeats As PartFeatures
    Dim ptfeatsSculpt As SculptFeatures
    Dim sbInt As WorkSurface
    Dim sbIntSculpt As SculptSurface
    
    Set ptFeats = ptBasePart.Features
    Set ptfeatsSculpt = ptFeats.SculptFeatures
    
    Set sbIntSculpt = ptBasePart.Features.SculptFeatures.CreateSculptSurface(wsSurf2Sculpt)
    sbIntSculpt.Direction = kSymmetricExtentDirection
    
    Dim ocSculpt As ObjectCollection
    Set ocSculpt = ThisApplication.TransientObjects.CreateObjectCollection
    Call ocSculpt.Add(sbIntSculpt)
    
    Set ptfeatSculpt = ptfeatsSculpt.Add(ocSculpt, kNewBodyOperation)
    
End Sub

 
Public Sub ChangePartColor(coPart As ComponentOccurrence, strColor As String)

    Dim oPartDoc As PartDocument
    Dim oCompDef As ComponentDefinition

    Set oPartDoc = coPart.Definition.Document
    Set oCompDef = oPartDoc.ComponentDefinition
    Dim appAsset As Asset
    Dim oLib As AssetLibrary
    Set oLib = ThisApplication.AssetLibraries("Autodesk Appearance Library")
    Set appAsset = oLib.AppearanceAssets(strColor)
    oPartDoc.ActiveAppearance = appAsset
    
End Sub
Public Sub ChangeSBColor(sbPart As SurfaceBody, strColor As String)

    Dim appAsset As Asset
    Dim oLib As AssetLibrary
    Dim assyAssets As Assets
    Dim oPartDoc As PartDocument
    Dim oCompOcc As ComponentOccurrenceProxy
    Set oCompOcc = sbPart.Parent
    Set oPartDoc = oCompOcc.Definition.Document
    
    'Set appAsset = oPartDoc.AppearanceAssets.Item(strColor)
    Set oLib = ThisApplication.AssetLibraries("Inventor Material Library")
    Set appAsset = oLib.AppearanceAssets(strColor)
    
    ' Copy the library into the document.
    Dim docAsset As Asset
    Set docAsset = appAsset.CopyTo(oCompOcc, False)
    'Set docAsset = appAsset.CopyTo(oPartDoc, False)

    sbPart.Appearance = docAsset
    
End Sub

 My total code is this.

I have a problem w/ the last few lines trying to get docAsset to copy.  In your code you use "thisApplication.ActiveDocument" which for my code will wind up giving me the assembly.  oCompOcc and oPartDoc seem to read in just fine in the watch list but still give errors when trying to use the CopyTo method.  I tried to mimic your code by declaring the surfacebody as one from the part document as opposed to one of the componentoccurrence surfacebodies but got errors still.

I don't quite understand what's meant by "by the confusion between a body and component occurrence."  What am I missing? 

[ekinsb]

This code helps and I think it does go back to the statement I made before about some confusion about the difference between an occurrence and a body.  Here's a quick overview.

Body - The result of creating surfaces or solids in a part.  Solids are shown in the "Solid Bodies" folder in the browser and surfaces are shown in the "Surface Bodies" folder in the browser.  In the API both solids and surfaces are represented by the SurfaceBody object.  There is an IsSolid property on the object that indicates if it's representing a surface or solid.  Within a part you can assign a color to a body which overrides the part color.  You can also assign colors to individual features and faces.

ComponentOccurrence - An occurrence represents an instance of a part or assembly within an assembly.  Each time you place a part or an assembly into an assemblyl you're creating a new ComponentOccurrence.  An occurrence doesn't have any geometry on it's own but displays the geometry in the part or assembly that it references.  In an assembly you can change the color of an occurrence, which overrides the color as defined in the referenced part or assembly.  This is an override in the assembly and doesn't affect the original part or assembly.  Inventor also supports changing the color of a body within an occurrence which is also an override of the color defined in the original part.  Overriding the colors of features or faces is not supported in an assembly but can only be changed in the original part.

For example, let's say there is a part (cubes.ipt) that contains two cubes, each one being a unique body in the part.  Now, if we insert this part two times into an assembly we'll have two occurrences that both reference cubes.ipt.  If you make any changes to cubes.ipt and then open the assembly you'll see thouse changes reflected in both occurrences because they're referencing cubes.ipt.

Proxy - A proxy is an object that represents another object within a assembly.  For the example above there are two bodies; the two cubes in cubes.ipt.  However, when we look at the assembly we see four cubes because we have to occurrences of cubes.ipt.  These four cubes don't actually exist in the assembly Inventor makes it appear that they do.  It does this through proxies.  There is a unique proxy object for each of the four cubes.  If you change the color of one of the cubes you're actually overriding the color on the SurfaceBodyProxy that represents that specific cube.

In your code you're starting off by selecting three different occurrences, not bodies.  The ComponentOccurrence object has a SurfaceBodies property which returns the SurfaceBodyProxy objects associated with that occurrence.  You can set the appearance of these and it will change the color for that specific body proxy in the assembly.  Since the color is being assigned to something in the assembly, the appearance must be copied to the AssemblyDocument before it can be used. 

The ComponentOccurrence object also supports the Definition property which you are using.  If the occurrence represents a part, this returns the PartComponentDefinition of the part being referenced.  This means you've completely left the context of the assembly and are working only within the part.  You can do anything you would usually do with a part.  Changing colors here will change the colors in the part and you'll see it in all instances in the assembly.  For example, if I change the color of one of the cubes, in the assembly two cubes will change color because two of the cubes represent the same cube in the part.

I know this can all be a bit confusing and I'm happy to try and explain more if you need it.

[Anonymous]

are you saying if I use the partcomponentdefinition I need only access its asset library? And instead of passing an occurrence's surfacebody (proxy if Im reading you right) I should use a surfacebody from the part component definition? am I getting that right?

[Anonymous]

Okay, so I made the surfacebody a body from the part component definition instead of the occurrence.  Then tried to pull from the assets in the sufacebody parent.  Unfortuneately like you said, there's no definition for the asset in the parent document. 

However every time I try to use the copyto method I get an "Invalid procedure call or argument" error.  I don't understand what keeps causing this error?

Public Sub ChangeSBColor(sbPart As SurfaceBody, strColor As String)

    Dim appAsset As Asset
    Dim oLib As AssetLibrary

    Dim oParent As Object
    Dim oPartDoc As PartDocument

    Set oLib = ThisApplication.AssetLibraries("Inventor Material Library")
    Set appAsset = oLib.AppearanceAssets(strColor)
'
    Set oParent = sbPart.Parent
    Set oPartDoc = oParent.Document

     'Copy the library into the document.
    Dim docAsset As Asset
    
     Set docAsset = appAsset.CopyTo(oPartDoc, False)

     sbPart.Appearance = docAsset
    
End Sub

[ekinsb]

I think a small code sample might be the best but before I write something I want to be clear about the specifics of what you're trying to do.  In the example I gave below where we have a part with two bodies and that part is inserted into an assembly, there are two possibilities when looking at changing the color of bodies.  We can change the color of a body in the context of the assembly (SurfaceBodyProxy) which will result in just one of the four bodies seen in the assembly changing color.  Or we can change the color of the body in the part which will result in two of the bodies in the assembly changing color.

[Anonymous]

I'm trying to change the color of the surface body within the part itself.  Not the proxy. 

[ekinsb]

Here's some code that will do both; if a body is selected in an assembly it will change the color of the body proxy so only that single body will change color.  If a body is selected in a part it will change the color of the body in the part.  There's also some code that's commented out so that even if you select the body in an assembly it will change the color of the body in the part, thus affecting all bodies in the assembly that reference that part body.  Hopefully this helps and gets you past this challenge.

Public Sub TestColor()
    Dim body As SurfaceBody
    Set body = ThisApplication.CommandManager.Pick(kPartBodyFilter, "Select a body")
    
    ' If you always want to change it at the part level, get the real body from the proxy
    ' and pass that it.
'    If TypeOf body Is SurfaceBodyProxy Then
'        Set body = body.NativeObject
'    End If
    
    ' Change the color of the body.
    Call ChangeSBColor(body, "Canary")
End Sub


Public Sub ChangeSBColor(body As SurfaceBody, strColor As String)
    ' Get the parent document.  If the body is a proxy this will be an
    ' assembly document.  If not, it will be a part document.
    Dim parentDoc As Document
    If TypeOf body Is SurfaceBodyProxy Then
        Set parentDoc = body.Parent.Parent.Document
    Else
        Set parentDoc = body.Parent.Document
    End If

    ' Get the specified asset from the library.
    Dim oLib As AssetLibrary
    Set oLib = ThisApplication.AssetLibraries("Inventor Material Library")
    Dim appAsset As Asset
    Set appAsset = oLib.AppearanceAssets(strColor)

    ' Copy the assett into the document.
    Dim docAsset As Asset
    Set docAsset = appAsset.CopyTo(parentDoc, True)

    ' Change the appearance of the body.
    body.Appearance = docAsset
    
    ' Force a view update to see the results.
    ThisApplication.ActiveView.Update
End Sub

[sergio_duran]

Hi Brian,

Your code works very well, but I have a quick question: Why does it show an error when you assign the same color more than once?

For instance, the color is "Gold" and it works when I run it, then I'll change it to "Red" and it works too. However, if I want to go back to "Gold", which it was assigned before, then it shows an error. The error is: Run-time error '5': Invalid procedure call or argument

When I press debug, it shows the error on the following line: Set docAsset = appAsset.CopyTo(partDoc, False)

Do you know why I cannot repeat the same color?

Thanks!

[sergio_duran]

Brian,

Sorry I forgot to mention that I'm talking about your first reply. The code where you used "Gold". Why does it only allow to use that color once? Please try to make few changes (e.g. change it to "Yellow", "Red" and go back to "Gold" or "Yellow", one of the previous assigned colors)

Public Sub TestAppearanceChange()
    Dim partDoc As PartDocument
    Set partDoc = ThisApplication.ActiveDocument
    
    Dim oBody As SurfaceBody
    Set oBody = partDoc.ComponentDefinition.SurfaceBodies.Item(1)
    
    Call ChangeSBColor(oBody, "Gold")
End Sub


Public Sub ChangeSBColor(body As SurfaceBody, strColor As String)
    Dim appAsset As Asset
    Dim oLib As AssetLibrary
    Dim assAssets As Assets
    
    ' Get the parent part document.
    Dim partDoc As PartDocument
    Set partDoc = body.Parent.Document
    
    ' Get a spsecific appearance in a library.
    Set oLib = ThisApplication.AssetLibraries("Inventor Material Library")
    Set appAsset = oLib.AppearanceAssets(strColor)
    
    ' Copy the library into the document.
    Dim docAsset As Asset
    Set docAsset = appAsset.CopyTo(partDoc, False)
    
    ' Set the appeareance on the body.
    body.Appearance = docAsset
End Sub

[sergio_duran]

Hi Brian,

I also tried the code in iLogic making some changes (removing Set and changing the first Private Sub to Main Sub) and it works the first time I assign a color. When I repeat the same color later on, it shows an error. iLogic is getting the same error as the code in VBA

Thanks!

[sergio_duran]

Hi Brian,

As I'd mentioned the error is here SyntaxEditor Code Snippet

docAsset = appAsset.CopyTo(partDoc, False)

How can I modify this line to specify that it should only be copied if the color is not in the partDoc?

Thx!

[Owner2229]

Hi, you can try this iLogic code instead. I'm ussing it to re-color whole assemblies.

Sub Main()
	cName = "Gold"
	Dim oDoc As Document = ThisApplication.ActiveDocument
	Dim assetLib As AssetLibrary
	assetLib = ThisApplication.AssetLibraries.Item("Autodesk Appearance Library")
	oColor = assetLib.AppearanceAssets.Item(cName)
	OneDeeper(oDoc)
End Sub

Private cName As String
Private oColor As Asset

Sub OneDeeper(oDoc As Document)
	If oDoc.DocumentType.ToString = "kAssemblyDocumentObject" Then
		Dim aDoc As DocumentsEnumerator = oDoc.AllReferencedDocuments
		Dim iDoc As Document
		For Each iDoc In aDoc
			If iDoc.DocumentType.ToString = "kAssemblyDocumentObject" Then
				OneDeeper(iDoc)
			Else
				Dim xDoc As Document = ThisApplication.Documents.Open(iDoc.FullFileName, False)
				ApplyColor(xDoc)
				xDoc.Close(True)
			End If
		Next
	Else
		ApplyColor(oDoc)
	End If
End Sub

Sub ApplyColor(oDoc As Document)
	oDef = oDoc.ComponentDefinition
	Try ' Try to copy the color
		aColor = oColor.CopyTo(xDoc)
	Catch ' Get existing color
		aColor = oDoc.Assets(cName)
	End Try
	Dim oSB As SurfaceBody
	For Each oSB In oDef.SurfaceBodies ' Re-color every body in the doc
		oSB.Appearance = aColor
	Next
End Sub

Otherwise you'll need to overcome VBA's inability to use "Try...Catch" and use something like "On Error GoTo Errorhandler".

And in the "Errorhandler" write this:

Set docAsset = partDoc.Assets(strColor)

So, here are the last some lines of the code:

' ...
    ' Get a spsecific appearance in a library
    Set oLib = ThisApplication.AssetLibraries("Inventor Material Library")
    Set appAsset = oLib.AppearanceAssets(strColor)

    On Error GoTo ErrorHandler45
    
    ' Copy the library into the document
    Dim docAsset As Asset
    Set docAsset = appAsset.CopyTo(partDoc, False)
    
    ' Set the appeareance on the body
    body.Appearance = docAsset

    Exit Sub
ErrorHandler45:
    Set docAsset = partDoc.Assets(strColor)

    ' Set the appeareance on the body
    body.Appearance = docAsset
End Sub

Btw. Don't resurrect old threads, start your own and add a link to the old one.

[sergio_duran]

Thanks Mike! Next time I'll start a new thread. BTW, I'll do it because this works very well to change the original color of every body from an assembly, but I don't know how I can override it instead of changing the original color.

I'll start a new thread

[slavisa.todorovic]

Hello,

Your can find answer in API help, I add help page of CopyTo( ) method in attachment. 
So, before run command: Set docAsset = appAsset.CopyTo(partDoc, False) command, check whether partDoc.Assets collection contain asset that you want to coppy.
This procedure could work:

Dim i As Integer

Dim assetFlag As Boolean

assetFlag = False
For  i = 1 to partDoc.Assets.Count

     Set docAsset = partDoc.Assets.Item(i)

     If (docAsset.DisplayName = "Gold") Then

         assetFlag = True

     End if

Next i

If assetFlag Then

     body.Appearance = docAsset

Else

     Set docAsset = appAsset.CopyTo(partDoc, False)

     body.Appearance = docAsset

End If

Regards,
Slavisa