06-30-2023
05:02 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
06-30-2023
05:02 AM
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