Part Description and Part Name in Assembly Tree for all Parts and Subassemblies

[JShearer98]

Hi all,

I'm just trying to have the Assembly Tree in the format of (Part Number)(Part Description) for all parts and subassemblies in the assembly so I can more easily find parts when working in large assemblies.

I've tried using the below code (Best one so far) but they all have the same problem of: working when it is run manually but any attempt at using triggers (such as when opening assembly) results in an error message per part saying it cannot find parts but when you close all errors it has actually done what it was meant to do.

Obviously it is good that it works at all but when I am opening Assemblies with 50+ parts/subassemblies, shutting all the error messages is not optimal.

(A side note if anyone can also get it working for Weldment Assemblies as it errors out saying you cannot convert from string ':1' to type 'Double' would be helpful)

(Says Line 109 due to other formula above which have been commented out. Error occurs on the first line beginning with oPn=iProperties.Value)

Dim oDoc As AssemblyDocument = ThisApplication.ActiveDocument


Dim oOcc As ComponentOccurrence
i = 1
For Each oOcc In oDoc.ComponentDefinition.Occurrences.AllLeafOccurrences

	oSplit = Split(oOcc.Name, ":")
	oInstance = ":" & oSplit(UBound(oSplit))

	oPn = iProperties.Value(oOcc.Name, "Project", "Part Number")
	oDn = iProperties.Value(oOcc.Name, "Project", "Description")
	Try
		oOcc.Name = oPn & " (" & oDn & ")" & oInstance
	Catch
		oOcc.Name = oPn & " (" & oDn & ")" & oInstance + i
	End Try
	i = i + 1

Next

For Each oOcc In oDoc.ComponentDefinition.Occurrences
	i = 1
	If oOcc.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then

		oSplit = Split(oOcc.Name, ":")
		oInstance = ":" & oSplit(UBound(oSplit))

		oPn = iProperties.Value(oOcc.Name, "Project", "Part Number")
		oDn = iProperties.Value(oOcc.Name, "Project", "Description")
		Try
			oOcc.Name = oPn & " (" & oDn & ")" & oInstance
		Catch
			oOcc.Name = oPn & " (" & oDn & ")" & oInstance + i
		End Try
		i = i + 1

	End If
Next

[WCrihfield]

Looks like the same post in two different places, so I will post a link to where I just posted a reply to the other place this was posted, in the other conversation.

https://forums.autodesk.com/t5/inventor-programming-ilogic/show-part-number-and-description-in-tree/... 

Edit:  Looks like I replied too quickly...seems that this post is a bit different, and is working with component occurrence names, instead of just the Document.DisplayName property, and trying to incorporate the 'instance' Index back into the new component occurrence name.  Well, the advice I might offer is to not put similar code in both the Try side and the Catch side of a Try...Catch...End Try statement, because doing so can still result in an error, which the Try...Catch...End Try statement is supposed to help avoid.  So, I would suggest using some sort of 'loop', such as [For i As Integer = 1 To #...Next] type loop, where the value of 'i' increases by 1 each time, then only using the 'Try' side for attempting to set the new name, to avoid the potential error.  Then using that 'i' value as the 'instance' index.  Just remember to record whether the attempt worked or not, maybe with a Boolean, so your code will move on as soon as it is successful, instead of renaming the same occurrence a whole bunch of times.  😉

[WCrihfield · Accepted solution]

Here is another code you can try for this task.  This one is laid out in 3 routines, with the middle one purely for handling the recursive behavior, and the last one containing all code for processing a single occurrence.  This could have been done in 2 routines instead, but this way tends to be a bit cleaner.  I have not tested it yet myself, so be careful and test it on a small, unimportant, multi-level assembly first, to see if it will work as planned, before testing on a larger, more important one.

Sub Main
	Dim oADoc As AssemblyDocument = TryCast(ThisDoc.Document, Inventor.AssemblyDocument)
	If oADoc Is Nothing Then Return
	Dim oOccs As ComponentOccurrences = oADoc.ComponentDefinition.Occurrences
	RecurseComponents(oOccs, AddressOf SetOccurrenceNameToPartNumberAndDescription)
	oADoc.Update2(True)
	'oADoc.Rebuild2(True)
End Sub

Sub RecurseComponents(oComps As Inventor.ComponentOccurrences, ComponentProcess As Action(Of Inventor.ComponentOccurrence))
	If oComps Is Nothing OrElse oComps.Count = 0 Then Return
	For Each oComp As ComponentOccurrence In oComps
		ComponentProcess(oComp)
		If oComp.Suppressed = False AndAlso _
			oComp.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
			'recurse definitions independantly
			'RecurseComponents(oComp.Definition.Occurrences, ComponentProcess)
			'recurse while maintaining lineage/association with top/main assembly
			RecurseComponents(oComp.SubOccurrences, ComponentProcess)
		End If
	Next
End Sub

Sub SetOccurrenceNameToPartNumberAndDescription(oOcc As Inventor.ComponentOccurrence)
	If oOcc.Suppressed Then Return
	If oOcc.ReferencedDocumentDescriptor Is Nothing Then Return
	If oOcc.ReferencedDocumentDescriptor.ReferenceMissing Then Return
	Dim oOccDoc As Inventor.Document = oOcc.ReferencedDocumentDescriptor.ReferencedDocument
	'get Part Number
	Dim sPN As String = oOccDoc.PropertySets.Item(3).Item(2).Value
	If sPN = "" Then
		Logger.Warn("Document named '" & oOccDoc.DisplayName & "' had empty Part Number value!")
		Return 'exit routine, without going any further
	End If
	'get Description
	Dim sDesc As String = oOccDoc.PropertySets.Item(3).Item(14).Value
	If sDesc = "" Then
		Logger.Warn("Document named '" & oOccDoc.DisplayName & "' had empty Description value!")
		Return 'exit routine, without going any further
	End If
	Dim sNewOccBaseName As String = sPN & " <" & sDesc & ">"
	Dim sNewOccName As String = sNewOccBaseName
	Dim cSplitter As Char = ":"
	Dim iOccIndex As Integer = 1 'default value
	Dim sOccIndex As String = "" 'default value
	If oOcc.Name.Contains(cSplitter) Then
		sOccIndex = oOcc.Name.Split(cSplitter).Last()
		iOccIndex = CInt(sOccIndex)
		sOccIndex = cSplitter & sOccIndex
	End If
	If sOccIndex <> "" Then sNewOccName &= sOccIndex
	Dim bRenamed As Boolean = False
	For i As Integer = iOccIndex To 100
		If oOcc.Name = sNewOccName Then
			Exit For 'exit loop, since name is OK
		Else
			Try
				oOcc.Name = sNewOccName
				bRenamed = True
			Catch ex As Exception
				'Logger.Error("Error setting Name of '" & oOcc.Name & "' to & '" & sNewOccName & "'!")
			End Try
		End If
		If bRenamed Then Exit For
		i += 1
		sNewOccName = sNewOccBaseName & cSplitter & i.ToString
	Next
End Sub

If this solved your problem, or answered your question, please click ACCEPT SOLUTION .
Or, if this helped you, please click (LIKE or KUDOS) 👍.

[JShearer98]

Hi @WCrihfield,

It seems to be working perfectly thank you very much. Haven't had an error on simple or subassembled assemblies.

I will reply further if I notice any issues but assume no news is good news.

The issue I mentioned last was not in fact due to a Weldment part but due to the code crashing as it tried to read a suppressed parts iProperties.