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
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?
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.
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
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.
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
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!
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
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!
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!
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.
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
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