- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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 ?
Solved! Go to Solution.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
Jhoel Forshav
Download my free Inventor Addin - Hole Projector
LinkedIn | Ideas | Contributions | Blog posts | Website
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Thank you for your patience and interest.
The issue remain the same; impossibility to rename the components inside the iAssembly.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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 ![]()
Jhoel Forshav
Download my free Inventor Addin - Hole Projector
LinkedIn | Ideas | Contributions | Blog posts | Website
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
Jhoel Forshav
Download my free Inventor Addin - Hole Projector
LinkedIn | Ideas | Contributions | Blog posts | Website
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
Jhoel Forshav
Download my free Inventor Addin - Hole Projector
LinkedIn | Ideas | Contributions | Blog posts | Website
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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 ![]()
Jhoel Forshav
Download my free Inventor Addin - Hole Projector
LinkedIn | Ideas | Contributions | Blog posts | Website
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report