Need some help filtering Derrived components from occurences

[machiel.veldkamp]

I found a nice rule where the Textfile in the end shows which part get used in which assemblies.

But! If there is a part with a derrived component that gets counted as well. 

I want to exclude all derrived components and just get all the occurences in the assembly.

Can someone help me with that?

Thanks 

Sub Main()
	oTextSave = "C:\TEMP\iLogicBuffer.txt"
	Dim oSelectSet As SelectSet

	oWrite = System.IO.File.CreateText(oTextSave)

	Dim oDoc As Document = ThisApplication.ActiveDocument
	Dim oCD As ComponentDefinition = oDoc.ComponentDefinition
	Dim Occ As ComponentOccurrence
	Dim oDrawingView As DrawingView
	Dim oModelDoc As Document
	Dim oStr As String = ""

	Dim oList As New List(Of Object)

	oWrite.WriteLine("FILE REFERENCE TREE RAN FROM: " & oDoc.FullFileName)
	oWrite.Close

	For Each oModelDoc In oDoc.AllReferencedDocuments

		RecurReferencing(oModelDoc, oStr, 0)

	Next

	Process.Start("Notepad.exe", oTextSave)

End Sub

Sub RecurReferencing(oDoc As Document, oStr As String, Level As Integer)
	oTextSave = "C:\TEMP\iLogicBuffer.txt"
	Dim oRefDoc As Document
	'Dim oDerPartComp As DerivedPartComponent

	If Level = 0
		oStr = DocNameWExt(oDoc.FullFileName)
	Else
		'If oDoc.DocumentType() = DocumentTypeEnum.kDrawingDocumentObject Or oDoc.PropertySets.Item("Inventor Summary Information").Item("Comments").Value = ""
		'	oStr = DocNameWExt(oDoc.FullFilename) & " <- " & oStr
		'Else
		oStr = oStr & " -> " & DocNameWExt(oDoc.FullFileName)
		'End If
	End If



	If oDoc.ReferencingDocuments.Count < 1
		Try
			If oDoc.ComponentDefinition.ReferenceComponents.DerivedPartComponents.Count = 1 Then
				GoTo oEnd
			Else
				oWrite = System.IO.File.AppendText(oTextSave)
				oWrite.WriteLine(oStr)
				oWrite.Flush()
				oWrite.Close
			End If
		Catch
			oWrite = System.IO.File.AppendText(oTextSave)
				oWrite.WriteLine(oStr)
				oWrite.Flush()
				oWrite.Close
		End Try
	Else
		For Each oRefDoc In oDoc.ReferencingDocuments
			RecurReferencing(oRefDoc, oStr, Level + 1)
		Next
	End If
	oEnd :

End Sub

Function DocNameWExt(oName As String)
	oPos = Len(oName) - InStrRev(oName, "\", - 1)
	oNameWExt = Right(oName, oPos)
	Return oNameWExt
End Function

GOAL:

1-702597.ipt -> 2-700287.iam -> 2-700294.iam -> 2-700296.iam -> 4-700150.iam
1-702596.ipt -> 2-700287.iam -> 2-700294.iam -> 2-700296.iam -> 4-700150.iam
1-702595.ipt -> 2-700287.iam -> 2-700294.iam -> 2-700296.iam -> 4-700150.iam
1-702594.ipt -> 2-700287.iam -> 2-700294.iam -> 2-700296.iam -> 4-700150.iam
1-702592.ipt -> 2-700287.iam -> 2-700294.iam -> 2-700296.iam -> 4-700150.iam
1-702593.ipt -> 2-700287.iam -> 2-700294.iam -> 2-700296.iam -> 4-700150.iam

1-702604.ipt -> 2-700285.iam -> 2-700296.iam -> 4-700150.iam
1-702601.ipt -> 2-700285.iam -> 2-700296.iam -> 4-700150.iam
1-702600.ipt -> 2-700285.iam -> 2-700296.iam -> 4-700150.iam
1-702599.ipt -> 2-700285.iam -> 2-700296.iam -> 4-700150.iam
1-702598.ipt -> 2-700285.iam -> 2-700296.iam -> 4-700150.iam
1-702574.ipt -> 2-700285.iam -> 2-700296.iam -> 4-700150.iam
1-702573.ipt -> 2-700285.iam -> 2-700296.iam -> 4-700150.iam
1-702572.ipt -> 2-700285.iam -> 2-700296.iam -> 4-700150.iam
1-702571.ipt -> 2-700285.iam -> 2-700296.iam -> 4-700150.iam

(sorted if possible)

[felix.cortes5K3Y2]

Replying to follow the post.

[machiel.veldkamp · Accepted solution]

Sub Main()
	'oTextSave = "C:\TEMP\iLogicBuffer.txt"
	Dim oSelectSet As SelectSet
	oWrite = System.IO.File.CreateText(oTextSave)
	Dim oDoc As Document = ThisApplication.ActiveDocument
	Dim oCD As ComponentDefinition = oDoc.ComponentDefinition
	Dim oDrawingView As DrawingView
	Dim oModelDoc As Document
	Dim oStr As String = ""

	oBOM = oCD.BOM
	oBOM.StructuredViewEnabled = True
	oBOM.StructuredViewFirstLevelOnly = False
	Dim oBOMView As BOMView = oBOM.BOMViews.Item("Structured")
	Dim oBOMRow As BOMRow
	Dim oCompDef As ComponentDefinition
	Dim oList As New List(Of Object)

	oWrite.WriteLine("__THIS IS A INDEX FOR: " & DocNameWExt(oDoc.FullDocumentName))
	oWrite.WriteLine("__")
	oWrite.Close
	Trace.WriteLine("**** Before FOR loop")
	For Each oBOMRow In oBOMView.BOMRows
		Call RecurseBOMRow(oBOMRow, oStr, 0)
	Next
	
	Shell("Sort " & oTextSave & " /O " & oTextSave, vbHide) 'TOGGLE ON OR OF DEPENDING ON YOUR WISHES
	
	Process.Start("Notepad.exe", oTextSave)
	Shell("notepad.exe /p " + oTextSave)
End Sub

Shared oTextSave = "C:\TEMP\iLogicBufferTest.txt"


Sub RecurseBOMRow(oBOMRow As BOMRow, oStr As String, Level As Integer)
	Dim oCompDef As ComponentDefinition
	oCompDef = oBOMRow.ComponentDefinitions.Item(1)
	Dim TempDoc As Document = oCompDef.Document'.FullFileName
	Dim CurrentDoc As String = TempDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value 	'SHOW PARTNUMBER
	'Dim CurrentDoc As String = oCompDef.Document.FullFileName														'SHOW FILENAME
	

	If Level = 0
		oStr = DocNameWExt(CurrentDoc)
	Else
		oStr =   DocNameWExt(CurrentDoc)& " -> " & oStr
	End If
	If oBOMRow.ChildRows Is Nothing
		Try
			oWrite = System.IO.File.AppendText(oTextSave)
			oWrite.WriteLine(oStr)
			oWrite.Flush()
			oWrite.Close
		Catch
			Trace.WriteLine("Failed at level " & Level)
		End Try
	Else
		Try
			oWrite = System.IO.File.AppendText(oTextSave)
			oWrite.WriteLine(oStr)
			oWrite.Flush()
			oWrite.Close
		Catch
		End Try

		For Each oBOMRow2 In oBOMRow.ChildRows
			If Not oBOMRow.ChildRows Is Nothing ' Ooooh. Assembly.
				Try
					Call RecurseBOMRow(oBOMRow2, oStr, Level + 1)
				Catch
				End Try
			End If
		Next
	End If
End Sub

Function DocNameWExt(oName As String)
	oPos = Len(oName) - InStrRev(oName, "\", - 1)
	oNameWExt = Right(oName, oPos)
	Return oNameWExt
End Function

 Done.