Renaming components in assembly

[philippe.lagrue]

I have tried this code for renaming all components in an assembly :

Class ChgDisplayName
	Public name As String = "Part "
	Public cpt As Integer = 1
	
	
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
	Dim oPN As String = name & cpt
	'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
				If oInt > 10 Then
					oWorked = True
				End If
			End Try
		Loop
	Catch
		MsgBox("Failed to rename:  " & oCO.Name,,"")
	End Try
	
	If oWorked Then
		cpt += 1	
	End If
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

End Class

But it don't work for internal parts of an iAssembly :

Do you know why ?

Is there a solution ?

[ts2.cad3]

Hi,

 try to use this Sub main instead:

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
	For Each oOcc As ComponentOccurrence In oADef.Occurrences.AllReferencedOccurrences(asmDef).OfType(Of ComponentOccurrence)
	RenameOcc(oOcc)	
	
Next

[philippe.lagrue]

Thank you for the answer.

Here is the result (components are partially renamed) :

And in fact the program is aborted by this error

The code modified as you suggest :

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 As ComponentOccurrence In oADef.Occurrences.AllReferencedOccurrences(asmDef).OfType(Of ComponentOccurrence)
		RenameOcc(oOcc)	
	Next
	
	'end the Transaction
	oTransaction.End
End Sub

You can find the assembly in the link below.

[ts2.cad3]

ok some bugs deleted now:

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")
	'MessageBox.Show("1", "Title")
	
	'rename all comps
	For Each oOcc As ComponentOccurrence In oADef.Occurrences.AllReferencedOccurrences(oADef).OfType(Of ComponentOccurrence)
	RenameOcc(oOcc)	
	
Next
End Sub

Sub RenameOcc(oComp As ComponentOccurrence)
	'MessageBox.Show("2", "Title")
	'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
	Dim oPN As String = name & cpt
	'check if PN is empty (not filled in)
	If oPN = "" Or oPN = " " Then
		'MessageBox.Show("3", "Title")
		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
		'MessageBox.Show("4", "Title")
	Catch
		'MessageBox.Show("5", "Title")
		Dim oInt As Integer = 0
		Do Until oWorked = True
			oInt = oInt + 1
			Try
				oCO.Name = oPN & ":" & oInt
				oWorked = True
			Catch
				oWorked = False
				If oInt > 10 Then
					oWorked = True
				End If
			End Try
		Loop
	Catch
		MsgBox("Failed to rename:  " & oCO.Name,,"")
	End Try
	
	If oWorked Then
		cpt += 1	
	End If
End Sub

[JhoelForshav]

Hi @philippe.lagrue 

It seems like something like this should be enough to accomplish what you're trying to do?

Dim name As String = "Part"
Dim num As Integer = 1
Dim def As AssemblyComponentDefinition = ThisDoc.Document.ComponentDefinition
For Each oOcc As ComponentOccurrence In def.Occurrences.AllReferencedOccurrences(def)
	Try
		oOcc.Name = name & num
		num += 1
	Catch
		MsgBox("couldn't rename " & oOcc.Name)
	End Try
Next

[philippe.lagrue]

Thank you for your patience and interest.

The issue remain the same; impossibility to rename the components inside the iAssembly.

[philippe.lagrue]

Thank you Jhoel.

But it's not the subject of my worry.

[JhoelForshav]

I just made a more robust rule that also renames the occurrences in order in the tree. Tried it on an Assembly containing both iParts and iAssemblies and it works well for me:

Class ThisRule
	Dim name As String = "Part"
	Dim num As Integer = 1
	Dim existingOccs As ComponentOccurrencesEnumerator
	Sub Main
		Dim def As AssemblyComponentDefinition = ThisDoc.Document.ComponentDefinition
		existingOccs = def.Occurrences.AllReferencedOccurrences(def)
		For Each oOcc As ComponentOccurrence In def.Occurrences
			TraverseAndSetNames(oOcc)
		Next
	End Sub
	Sub RenameExisting(oName As String)
		Dim existingOccWithName As ComponentOccurrence = existingOccs.OfType(Of ComponentOccurrence).FirstOrDefault(Function(x) x.Name = oName)
		If existingOccWithName IsNot Nothing
			existingOccWithName.Name = oName & "_old"
		End If
	End Sub
	Sub RenameOcc(oOcc As ComponentOccurrence)
		oOcc.Name = name & num
		num += 1
	End Sub
	Sub TraverseAndSetNames(oOcc As ComponentOccurrence)
		RenameExisting(name & num)
		RenameOcc(oOcc)
		If oOcc.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject
			For Each sOcc As ComponentOccurrence In oOcc.SubOccurrences
				TraverseAndSetNames(sOcc)
			Next
		End If
	End Sub
End Class

 Let me know if it works for you or if I've misunderstood what you're trying to do 🙂

[philippe.lagrue]

Thanks Jhoel, but this rule fail when it try to rename the iAssembly components :

For information; the link to this assembly is available above: Assembly_02.zip 

[JhoelForshav · Accepted solution]

@philippe.lagrue

I managed to change the names in the iAssembly by accessing the factory document of the iAssembly and changing the occurrence name in there. See if this works for you:

Class ThisRule
	Dim name As String = "Part"
	Dim num As Integer = 1
	Dim existingOccs As ComponentOccurrencesEnumerator
	Sub Main
		iLogicvb.UpdateWhenDone = True
		Dim def As AssemblyComponentDefinition = ThisDoc.Document.ComponentDefinition
		existingOccs = def.Occurrences.AllReferencedOccurrences(def)
		For Each oOcc As ComponentOccurrence In def.Occurrences
			TraverseAndSetNames(oOcc)
		Next
	End Sub
	Sub RenameExisting(oName As String, Optional eOccs As ComponentOccurrencesEnumerator = Nothing)
		Dim existingOccWithName As ComponentOccurrence
		If eOccs Is Nothing
			existingOccWithName = existingOccs.OfType(Of ComponentOccurrence).FirstOrDefault(Function(x) x.Name = oName)
		Else
			existingOccWithName = eOccs.OfType(Of ComponentOccurrence).FirstOrDefault(Function(x) x.Name = oName)
		End If
		If existingOccWithName IsNot Nothing
			existingOccWithName.Name = oName & "_old"
		End If
	End Sub
	Sub RenameOcc(oOcc As ComponentOccurrence)
		oOcc.Name = name & num
		num += 1
	End Sub
	Sub TraverseAndSetNames(oOcc As ComponentOccurrence, Optional eOccs As ComponentOccurrencesEnumerator = Nothing)
		RenameExisting(name & num, eOccs)
		RenameOcc(oOcc)
		If oOcc.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject
			If oOcc.IsiAssemblyMember
				Dim iAssyMember As iAssemblyMember = oOcc.Definition.iAssemblyMember
				Dim def As AssemblyComponentDefinition = iAssyMember.ReferencedDocumentDescriptor.ReferencedDocument.ComponentDefinition
				For Each sOcc As ComponentOccurrence In def.Occurrences
					TraverseAndSetNames(sOcc, def.Occurrences.AllReferencedOccurrences(def))
				Next
				iAssyMember.ReferencedDocumentDescriptor.ReferencedDocument.Save2(True)
			Else
				For Each sOcc As ComponentOccurrence In oOcc.SubOccurrences
					TraverseAndSetNames(sOcc)
				Next
			End If
		End If
	End Sub
End Class

[philippe.lagrue · Accepted solution]

Thank you very much Jhoel, it work nice.

[philippe.lagrue]

I try now to convert your code to a VBA macro.

I have some difficulties with this line :

existingOccWithName = existingOccs.OfType(Of ComponentOccurrence).FirstOrDefault(Function(x) x.Name = oName)

[JhoelForshav · Accepted solution]

Hi @philippe.lagrue 

VBA doesn't support lambda expressions so we'll have to rewrite the function to instead loop through the ComponentOccurrencesEnumerator to check if there's already an occurrence with the name.

Something like this should work 🙂

Option Explicit

Dim name As String
Dim num As Integer
Dim existingOccs As ComponentOccurrencesEnumerator

Sub Main()
    Dim def As AssemblyComponentDefinition
    Set def = ThisApplication.ActiveDocument.ComponentDefinition
    Set existingOccs = def.Occurrences.AllReferencedOccurrences(def)
    num = 1
    name = "Part"
    
    Dim oOcc As ComponentOccurrence
    For Each oOcc In def.Occurrences
        TraverseAndSetNames oOcc
    Next oOcc
    def.Document.Update
End Sub

Sub RenameExisting(oName As String, Optional eOccs As ComponentOccurrencesEnumerator = Nothing)
    Dim existingOccWithName As ComponentOccurrence
    Dim oOcc As ComponentOccurrence
    
    If eOccs Is Nothing Then
        For Each oOcc In existingOccs
            If oOcc.name = oName Then
                Set existingOccWithName = oOcc
                Exit For
            End If
        Next oOcc
    Else
        For Each oOcc In eOccs
            If oOcc.name = oName Then
                Set existingOccWithName = oOcc
                Exit For
            End If
        Next oOcc
    End If
    
    If Not existingOccWithName Is Nothing Then
        existingOccWithName.name = oName & "_old"
    End If
End Sub

Sub RenameOcc(oOcc As ComponentOccurrence)
    oOcc.name = name & num
    num = num + 1
End Sub

Sub TraverseAndSetNames(oOcc As ComponentOccurrence, Optional eOccs As ComponentOccurrencesEnumerator = Nothing)
    RenameExisting name & num, eOccs
    RenameOcc oOcc
    
    If oOcc.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
        If oOcc.IsiAssemblyMember Then
            Dim iAssyMember As iAssemblyMember
            Set iAssyMember = oOcc.Definition.iAssemblyMember
            Dim def As AssemblyComponentDefinition
            Set def = iAssyMember.ReferencedDocumentDescriptor.ReferencedDocument.ComponentDefinition
            
            Dim iOcc As ComponentOccurrence
            For Each iOcc In def.Occurrences
                TraverseAndSetNames iOcc, def.Occurrences.AllReferencedOccurrences(def)
            Next iOcc
            
            iAssyMember.ReferencedDocumentDescriptor.ReferencedDocument.Save2 True
        Else
            Dim sOcc As ComponentOccurrence
            For Each sOcc In oOcc.SubOccurrences
                TraverseAndSetNames sOcc
            Next sOcc
        End If
    End If
End Sub

[GosponZ]

JhoelForshav

  that rule work just perfect like any of yours rules. I do have question:  running this rule in browser tree is changed name but how that name change into part number? 

[philippe.lagrue]

Great , thank you Jhoel.

[JhoelForshav]

Hi @GosponZ 

If I understand correctly, you want to use the part number as the name of each occurrence in the assembly.

Something like this should do the trick 🙂

Class ThisRule
	Sub Main
		iLogicvb.UpdateWhenDone = True
		Dim def As AssemblyComponentDefinition = ThisDoc.Document.ComponentDefinition
		For Each oOcc As ComponentOccurrence In def.Occurrences
			TraverseAndSetNames(oOcc)
		Next
	End Sub
	Sub RenameOcc(oOcc As ComponentOccurrence)
		Dim partNum As String = oOcc.Definition.Document.PropertySets("{32853F0F-3444-11D1-9E93-0060B03C1CA6}").ItemByPropId(5).Value
		If oOcc.Parent.Occurrences.OfType(Of ComponentOccurrence).FirstOrDefault(Function(x) x.Name = partNum Or x.Name.StartsWith(partNum & ":")) Is Nothing
			oOcc.Name = partNum
		ElseIf oOcc.Parent.Occurrences.OfType(Of ComponentOccurrence).FirstOrDefault(Function(x) x.Name = partNum AndAlso x IsNot oOcc) Is Nothing
			oOcc.Name = partNum
		Else
			Dim i As Integer = 1
			For Each eOcc As ComponentOccurrence In oOcc.Parent.Occurrences
				If eOcc.Name = partNum Or eOcc.Name.StartsWith(partNum & ":")
					If eOcc IsNot oOcc
						Dim oName As String = partNum & ":" & i
						Dim existingOcc As ComponentOccurrence = oOcc.Parent.Occurrences.OfType(Of ComponentOccurrence).FirstOrDefault(Function(x) x.Name = oName)
						If existingOcc IsNot Nothing Then existingOcc.Name = oName & "_temp"
						eOcc.Name = oName
						i += 1
					End If
				End If
			Next
			oOcc.Name = partNum & ":" & i
		End If
		
	End Sub
	Sub TraverseAndSetNames(oOcc As ComponentOccurrence)
		RenameOcc(oOcc)
		If oOcc.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject
			If oOcc.IsiAssemblyMember
				Dim iAssyMember As iAssemblyMember = oOcc.Definition.iAssemblyMember
				Dim def As AssemblyComponentDefinition = iAssyMember.ReferencedDocumentDescriptor.ReferencedDocument.ComponentDefinition
				For Each sOcc As ComponentOccurrence In def.Occurrences
					TraverseAndSetNames(sOcc)
				Next
				iAssyMember.ReferencedDocumentDescriptor.ReferencedDocument.Save2(True)
			Else
				For Each sOcc As ComponentOccurrence In oOcc.SubOccurrences
					TraverseAndSetNames(sOcc)
				Next
			End If
		End If
	End Sub
End Class

 I had to add numbering to the names if there are multiple occurrences in the same assembly with the same part number. I used a colon as a separator for this (<Part Number>:<Number>). If you use part numbers containing colons maybe use another character for the saparation 🙂

[GosponZ]

Just opposite.