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

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