Adding custom iproperty to selected parts in an assembly

[m.rymut]

Hi,

i have a rule that lets me add 5 custom properties to a part.

I wanted to modify the rule so that i can run it in an assembly and add those 5 iproperties to all selected parts.

The rule i use ( it is a rule i found on this Forum and modyfied it):

customPropertySet = ThisDoc.Document.PropertySets.Item("Inventor User Defined Properties")

Dim iprop(5) As String
iprop(1) = "Materiał"
iprop(2) = "Wykończenie"
iprop(3) = "Kolor"
iprop(4) = "Opis"
iprop(5) = "Informacje dodatkowe"

For k = 1 To 5
Dim prop(k) As String
    Try
        prop(k) = iProperties.Value("Custom", iprop(k))
    Catch
        'Assume error means not found
        customPropertySet.Add("", iprop(k))
        iProperties.Value("Custom", iprop(k)) = "null"
    End Try
Next
For j = 1 To 5
    Dim var(j) As String
    If iProperties.Value("Custom", iprop(j)) = "null" Or iProperties.Value("Custom", iprop(j)) = "" Then
        var(j) = InputBox("Proszę wpisać wartość dla: " & iprop(j), "Warning", "")
        iProperties.Value("Custom", iprop(j)) = var(j)
		Else
			If j = 1 Or j= 3 Or j= 4 Then
			question = MessageBox.Show(iprop(j) & " jest już określony: " & vbLf & iProperties.Value("Custom", iprop(j)) & vbLf & "Czy chcesz zmienić " & iprop(j) & "?", "IProperty już określone", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
				If question = vbYes Then
				var(j) = InputBox("Proszę wpisać nową wartość dla: " & iprop(j), "Warning", "")
        		iProperties.Value("Custom", iprop(j)) = var(j)
				End If
			Else
				If j = 2 Then
				question = MessageBox.Show(iprop(j) & " jest już określone: " & vbLf & iProperties.Value("Custom", iprop(j)) & vbLf & "Czy chcesz zmienić " & iprop(j) & "?", "IProperty już określone", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
					If question = vbYes Then
					var(j) = InputBox("Proszę wpisać nową wartość dla: " & iprop(j), "Warning", "")
        			iProperties.Value("Custom", iprop(j)) = var(j)
					End If
				Else
					If j = 5 Then
					question = MessageBox.Show(iprop(j) & " są już określone: " & vbLf & iProperties.Value("Custom", iprop(j)) & vbLf & "Czy chcesz zmienić " & iprop(j) & "?", "IProperty już określone", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
						If question = vbYes Then
						var(j) = InputBox("Proszę wpisać nową wartość dla: " & iprop(j), "Warning", "")
        				iProperties.Value("Custom", iprop(j)) = var(j)
						End If
					End If
				End If
			End If

	    End If
	
Next

I tried modifying it by adding oSelect but i couldnt get it to work

[A.Acheson · Accepted solution]

Here is your rule integrated into a pick assembly occurrence rule. At the moment when all occurrence have been picked each file is processed separately. If you want to process them all with the same iProperties and values  the rule will need to be changed to suit. 

'Description of the Rule and if you want to continue
 Result = MessageBox.Show("Do you want to continue?" _
& vbNewLine &"" _
& vbNewLine & "This rule allows you to browse the tree and select multiple items,then press the Esc Key and have an action carried out" _
& vbNewLine & "", "Browse And Select" _
, MessageBoxButtons.YesNoCancel, MessageBoxIcon.Exclamation, MessageBoxDefaultButton.Button2)

If Result = vbNo Then
	MessageBox.Show ("Rule Canceled Exiting", "Title")
ElseIf Result = vbYes Then
	
	Dim oDoc As AssemblyDocument
	oDoc = ThisDoc.Document
	oCompDef = oDoc.ComponentDefinition

	Dim oSet As HighlightSet
	oSet = oDoc.CreateHighlightSet
	'MessageBox.Show ("Rule will Run", "Title")
	'[Pick Assembly Occurrences
	Dim comps As ObjectCollection
	Dim comp As Object

	comps = ThisApplication.TransientObjects.CreateObjectCollection

	While True
		comp = ThisApplication.CommandManager.Pick(
			SelectionFilterEnum.kAssemblyLeafOccurrenceFilter, 
			"Select a component") 

		' If nothing gets selected then we're done	
		If IsNothing(comp) Then Exit While
			comps.Add(comp)
			oSet.AddItem(comp)
	End While
	'Description of the Rule and if you want to continue
	Result = MessageBox.Show("Do you want to process all Selected?", "Process selected files", MessageBoxButtons.YesNoCancel, MessageBoxIcon.Exclamation, MessageBoxDefaultButton.Button2)

	If Result = vbNo Then
	MessageBox.Show ("Rule Cancelled", "iLogic")

	 'If there are selected Components we can Do something
	ElseIf Result = vbYes Then
		For Each comp In comps
			'Pick only parts
			If comp.DefinitionDocumentType = kPartDocumentObject Then
				'Get document of each occurrence
				Dim oOccDoc As Document
				oOccDoc = comp.Definition.Document
				'[Add custom iProp
				customPropertySet = oOccDoc.PropertySets.Item("Inventor User Defined Properties")
				Dim iprop(5) As String
				iprop(1) = "Material"
				iprop(2) = "Wykonczenie"
				iprop(3) = "Kolor"
				iprop(4) = "Opis"
				iprop(5) = "Informacje dodatkowe"

				For k = 1 To 5
				Dim prop(k) As String
				    Try
				        prop(k) = iProperties.Value(oOccDoc.DisplayName,"Custom", iprop(k))
				    Catch
				        'Assume error means not found
				        customPropertySet.Add("", iprop(k))
				        iProperties.Value(oOccDoc.DisplayName,"Custom", iprop(k)) = "null"
				    End Try
				Next
				For j = 1 To 5
				    Dim var(j) As String
				    If iProperties.Value(oOccDoc.DisplayName,"Custom", iprop(j)) = "null" Or iProperties.Value(oOccDoc.DisplayName,"Custom", iprop(j)) = "" Then
				        var(j) = InputBox("Prosze wpisac wartosc dla: " & iprop(j), "Warning", "")
				        iProperties.Value(oOccDoc.DisplayName,"Custom", iprop(j)) = var(j)
						Else
							If j = 1 Or j= 3 Or j= 4 Then
							question = MessageBox.Show(iprop(j) & " jest juz okreslony: " & vbLf & iProperties.Value(oOccDoc.DisplayName,"Custom", iprop(j)) & vbLf & "Czy chcesz zmienic " & iprop(j) & "?", "IProperty juz okreslone", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
								If question = vbYes Then
								var(j) = InputBox("Prosze wpisac nowa wartosc dla: " & iprop(j), "Warning", "")
				        		iProperties.Value(oOccDoc.DisplayName,"Custom", iprop(j)) = var(j)
								End If
							Else
								If j = 2 Then
								question = MessageBox.Show(iprop(j) & " jest juz okreslone: " & vbLf & iProperties.Value("Custom", iprop(j)) & vbLf & "Czy chcesz zmienic " & iprop(j) & "?", "IProperty juz okreslone", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
									If question = vbYes Then
									var(j) = InputBox("Prosze wpisac nowa wartosc dla: " & iprop(j), "Warning", "")
				        			iProperties.Value(oOccDoc.DisplayName,"Custom", iprop(j)) = var(j)
									End If
								Else
									If j = 5 Then
									question = MessageBox.Show(iprop(j) & " sa juz okreslone: " & vbLf & iProperties.Value(oOccDoc.DisplayName,"Custom", iprop(j)) & vbLf & "Czy chcesz zmienic " & iprop(j) & "?", "IProperty juz okreslone", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
										If question = vbYes Then
										var(j) = InputBox("Prosze wpisac nowa wartosc dla: " & iprop(j), "Warning", "")
				        				iProperties.Value(oOccDoc.DisplayName,"Custom", iprop(j)) = var(j)
										End If
									End If
								End If
							End If
					    End If
				Next
				']
				MessageBox.Show (comp.Name, "iLogic")
			Else
				MessageBox.Show ("An Assembly file:-" & comp.Name & " was selected so skipping", "iLogic")
			End If
		
	
		Next
	MessageBox.Show("Files Processed", "iLogic")
	'Clear Highlighting
	oSet.Clear()
	End If
']
End If
  

[m.rymut]

Works great, thank you very much.