Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
WCrihfield
in reply to: WCrihfield

I created an iLogic rule that will attempt to rename every component on every level of the assembly, to the component's Part Number.  And if there are multiple the same component within an assembly, it attempts to add the ":" and an Integer to the end of the component name.

Here's the code:

Sub Main
	If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
		MsgBox("An Assembly Document must be active for this rule to work. Exiting.",vbOKOnly+vbCritical, "WRONG DOCUMENT TYPE")
		Exit Sub
	End If
	Dim oADoc As AssemblyDocument = ThisApplication.ActiveDocument
	Dim oADef As AssemblyComponentDefinition = oADoc.ComponentDefinition
	Dim oOcc As ComponentOccurrence
	
	'Start a Transaction to bundle all the name changes into a single item in the 'Undo' menu.
	Dim oTransaction As Transaction = ThisApplication.TransactionManager.StartTransaction(oADoc, "Rename Components")
		
	'rename all comps in top level first
	For Each oOcc In oADef.Occurrences
		RenameOcc(oOcc)
	Next
	'now try to rename comps at deeper levels
	For Each oOcc In oADef.Occurrences
		If oOcc.SubOccurrences.Count > 0 Then 'it is a sub-assembly
			'run 'recursive' sub here
			'and supply the SubOccurrences to it
			Iterate(oOcc.SubOccurrences)
		End If
	Next
	'end the Transaction
	oTransaction.End
End Sub

Sub RenameOcc(oComp As ComponentOccurrence)
	'create new variable to enable 'Intellisense' recognition
	Dim oCO As ComponentOccurrence = oComp
	'get the PN
	Dim oCODoc As Document = oCO.Definition.Document
	Dim oPN As String = oCODoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
	'check if PN is empty (not filled in)
	If oPN = "" Or oPN = " " Then
		MsgBox("Occurrence '" & oCO.Name & "' has an 'Empty' Part Number." & vbCrLf & _
		"Leaving original component name as it was.", , "")
		'oPN = oCO.Name
		Exit Sub
	End If
	
	'attempt to rename the component
	Dim oWorked As Boolean = False
	Try
		oCO.Name = oPN
	Catch
		Dim oInt As Integer = 0
		Do Until oWorked = True
			oInt = oInt + 1
			Try
				oCO.Name = oPN & ":" & oInt
				oWorked = True
			Catch
				oWorked = False
			End Try
		Loop
	Catch
		MsgBox("Failed to rename:  " & oCO.Name,,"")
	End Try
End Sub

Sub Iterate(oOccs As ComponentOccurrencesEnumerator)
	'create new variable to enable 'Intellisense' recognition
	Dim oComps As ComponentOccurrencesEnumerator = oOccs
	Dim oCO As ComponentOccurrence
	'try to rename all comps at this level first
	For Each oCO In oComps
		RenameOcc(oCO)
	Next
	'now loop through again checking for SubOccurrences, then Iterate
	For Each oCO In oComps
		If oCO.SubOccurrences.Count > 0 Then 'it is a sub-assembly
			Iterate(oCO.SubOccurrences)
		End If
	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) :thumbs_up:.

If you have time, please... Vote For My IDEAS :light_bulb:or you can Explore My CONTRIBUTIONS

Inventor 2021 Help | Inventor Forum | Inventor Customization Forum | Inventor Ideas Forum

Wesley Crihfield

EESignature

(Not an Autodesk Employee)