Coloring of certain parts including the assembly through ilogic

[FrankHermens4Y53K]

Hello,

I have made a rule (from parts from the internet) that finds and colors parts in a big assembly. It does this by creating a layer and adding the lines of the part in that layer. It looks for a certain word of numbers that the user types in. then the user can select a color from a list (InputListBox). This all works but now i want to add the following:

I want the rule to also color (the same color) the assembly with contains the part. for example:

In the figure below it found and colored the orange part but I want it to also color the tube. they are in the same assembly so it can color the whole assembly or the tube allone, that does not matter to me.

The comlete code I use is this: (there is some dutch in it. If it is necessary i can translate it and post it again)

Sub Main()
' Get the active drawing document.
Dim drawDoc As DrawingDocument
drawDoc = ThisApplication.ActiveDocument


Onderdeel = InputBox("Vul het AE of LI nummer in van de voetplaat (let op het is hoofdletter gevoellig)", "Onderdeel bevat woord", "LI0196")
If Onderdeel = "" Then Exit Sub

' Have the user select a drawing view.
Dim drawView As DrawingView
MsgBox("Selecteer een View", , "Informatie")
drawView = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingViewFilter, "Select View")

Dim docDesc As DocumentDescriptor
docDesc = drawView.ReferencedDocumentDescriptor

'------------------------------------------------------------------------------beveiliging
' Verify that the selected drawing view is of an assembly.
If docDesc.ReferencedDocumentType <> kAssemblyDocumentObject Then
	MsgBox("Het geselecteerde View moet van een assembly zijn.")
	Exit Sub
End If
'------------------------------------------------------------------------------beveiliging

' Get the component definition for the assembly.
Dim asmDef As AssemblyComponentDefinition
asmDef = docDesc.ReferencedDocument.ComponentDefinition

' Process the occurrences, wrapping it in a transaction so the
' entire process can be undone with a single undo operation.
Dim trans As Transaction
trans = ThisApplication.TransactionManager.StartTransaction( _
drawDoc, "Veranderen van kleur onderdelen")

'Aanmaken van de multivalue list in de samenstelling -----------------------------------------------------------------------
Dim oView2 As DrawingView

view_naam = drawView.Name
oView2 = ActiveSheet.View(view_naam).View

Dim oModel As AssemblyDocument
oModel = oView2.ReferencedDocumentDescriptor.ReferencedDocument

oMyParameter = oModel.ComponentDefinition.Parameters.UserParameters
oParameter = oMyParameter.AddByValue("Kleur", "Rood", UnitsTypeEnum.kTextUnits)

Dim List(0 To 6) As String
List(0) = """Rood"""
List(1) = """Blauw"""
List(2) = """Groen"""
List(3) = """Geel"""
List(4) = """Oranje"""
List(5) = """Megenta"""
List(6) = """Cyaan"""

Dim oExprList As ExpressionList
oExprList = oParameter.ExpressionList

Call oExprList.SetExpressionList(List, False)

oKleur = InputListBox("(Bij kruisje wordt alles terug gezet In de 'by standard' layer)", List, "Rood", Title := "Kies kleur", ListName := "Kies kleur")
'--------------------------------------------------------------------------------------------------------------------------------------------------------------

' Call the recursive function that does all the work.
Call ProcessAssemblyColor(drawView, asmDef.Occurrences, Onderdeel, oKleur)

' Verwijderen van de aangemaakte parameters
param = oModel.ComponentDefinition.Parameters.Item("Kleur")
param.Delete

trans.End
End Sub



Private Sub ProcessAssemblyColor(drawView As DrawingView, Occurrences As ComponentOccurrences, Onderdeel As String, oKleur As String)

	' Iterate through the current collection of occurrences.
	Dim occ As ComponentOccurrence
	For Each occ In Occurrences
		'msgbox(occ.Parent.Document.FullFileName) 'geeft het AE nummer van de samenstelling aan AE0106211
		
			occParent = occ.Parent
		' Check to see if this occurrence is a part or assembly.
		If occ.DefinitionDocumentType = kPartDocumentObject Then
			' ** It's a part so process the color. 

			' Get the TransientsObjects object to use later.
			Dim transObjs As TransientObjects
			transObjs = ThisApplication.TransientObjects

			Dim drawDoc As DrawingDocument
			drawDoc = drawView.Parent.Parent

			' Kleuren aan maaken
			Dim oDoc As DrawingDocument
			oDoc = ThisApplication.ActiveDocument

			Dim layers As LayersEnumerator
			layers = oDoc.StylesManager.Layers

			Dim oRed As Layer
			Dim oGreen As Layer
			Dim oBlue As Layer
			Dim oYellow As Layer
			Dim oCyaan As Layer
			Dim oMegenta As Layer
			Dim oOranje As Layer

			Dim oKleur_layer As Layer

			'---------------------------------------------------------- Rood
			On Error Resume Next

			oRed = layers.Item("Rood")

			If Err.Number <> 0 Then
				On Error GoTo 0

				Dim redColor As Color
				redColor = ThisApplication.TransientObjects.CreateColor(255, 0, 0)

				' Copy an arbitrary layer giving it the name
				' of the render style.
				oRed = layers.Item(1).Copy("Rood")

				' the attributes of the layer to use the color,
				' have a solid line type, and a specific width.
				oRed.Color = redColor
				oRed.LineType = kContinuousLineType
				oRed.LineWeight = 0.02
			End If

			'---------------------------------------------------------- Groen
			On Error Resume Next

			oGreen = layers.Item("Groen")

			If Err.Number <> 0 Then
				On Error GoTo 0

				Dim greenColor As Color
				greenColor = ThisApplication.TransientObjects.CreateColor(0, 255, 0)

				oGreen = layers.Item(1).Copy("Groen")

				oGreen.Color = greenColor
				oGreen.LineType = kContinuousLineType
				oGreen.LineWeight = 0.02
			End If

			'---------------------------------------------------------- Blauw
			On Error Resume Next

			oBlue = layers.Item("Blauw")

			If Err.Number <> 0 Then
				On Error GoTo 0

				Dim blueColor As Color
				blueColor = ThisApplication.TransientObjects.CreateColor(0, 0, 255)

				oBlue = layers.Item(1).Copy("Blauw")

				oBlue.Color = blueColor
				oBlue.LineType = kContinuousLineType
				oBlue.LineWeight = 0.02
			End If

			'---------------------------------------------------------- Geel
			On Error Resume Next

			oYellow = layers.Item("Geel")

			If Err.Number <> 0 Then
				On Error GoTo 0

				Dim yellowColor As Color
				yellowColor = ThisApplication.TransientObjects.CreateColor(255, 255, 0)

				oYellow = layers.Item(1).Copy("Geel")

				oYellow.Color = yellowColor
				oYellow.LineType = kContinuousLineType
				oYellow.LineWeight = 0.02
			End If

			'---------------------------------------------------------- Cyaan
			On Error Resume Next

			oCyaan = layers.Item("Cyaan")

			If Err.Number <> 0 Then
				On Error GoTo 0

				Dim CyaanColor As Color
				CyaanColor = ThisApplication.TransientObjects.CreateColor(0, 255, 255)

				oCyaan = layers.Item(1).Copy("Cyaan")

				oCyaan.Color = CyaanColor
				oCyaan.LineType = kContinuousLineType
				oCyaan.LineWeight = 0.02
			End If

			'---------------------------------------------------------- Megenta
			On Error Resume Next

			oMegenta = layers.Item("Megenta")

			If Err.Number <> 0 Then
				On Error GoTo 0

				Dim MegentaColor As Color
				MegentaColor = ThisApplication.TransientObjects.CreateColor(255, 0, 255)

				oMegenta = layers.Item(1).Copy("Megenta")

				oMegenta.Color = MegentaColor
				oMegenta.LineType = kContinuousLineType
				oMegenta.LineWeight = 0.02
			End If

			'---------------------------------------------------------- Oranje
			On Error Resume Next

			oOranje = layers.Item("Oranje")

			If Err.Number <> 0 Then
				On Error GoTo 0

				Dim OranjeColor As Color
				OranjeColor = ThisApplication.TransientObjects.CreateColor(255, 128, 0)

				oOranje = layers.Item(1).Copy("Oranje")

				oOranje.Color = OranjeColor
				oOranje.LineType = kContinuousLineType
				oOranje.LineWeight = 0.02
			End If

			'----------------------------------------------------------
		If oKleur = """Rood""" Then
		oKleur_layer = oRed
		Else If oKleur = """Blauw""" Then
		oKleur_layer = oBlue
		Else If oKleur = """Groen""" Then
		oKleur_layer = oGreen
		Else If oKleur = """Geel""" Then
		oKleur_layer = oYellow
		Else If oKleur = """Cyaan""" Then
		oKleur_layer = oCyaan
		Else If oKleur = """Magenta""" Then
		oKleur_layer = oMegenta
		Else If oKleur = """Oranje""" Then
		oKleur_layer = oOranje
		End If

		' Get all of the curves associated with this occurrence.

		On Error Resume Next
		Dim drawcurves As DrawingCurvesEnumerator
		drawcurves = drawView.DrawingCurves(occ)
		If Err.Number = 0 Then
			On Error GoTo 0

			' Create an empty collection.
			Dim objColl As ObjectCollection
			objColl = transObjs.CreateObjectCollection()

			' Add the curve segments to the collection.
			Dim drawCurve As DrawingCurve
			For Each drawCurve In drawcurves
				Dim segment As DrawingCurveSegment
				For Each segment In drawCurve.Segments
					objColl.Add(segment)
				Next
			Next
			Dim occName As String
			occName = occ.Definition.Document.FullDocumentName
			If occName.Contains(Onderdeel) = True Then
				' Change the layer of all of the segments.
				Call drawView.Parent.ChangeLayer(objColl, oKleur_layer)
			End If
		End If
		On Error GoTo 0
		Else
			' It's an assembly so process its contents.
			Call ProcessAssemblyColor(drawView, occ.SubOccurrences, Onderdeel, oKleur)
		End If
	Next
End Sub

Thanks in advance,

Frank