Create empty Parts List on drawing and fill rows by itterate the assembly browser pane

[checkcheck_master]

Is it possible to create an empty parts list on a drawing and to create the rows by traverse the browser pane?

The goal is to have the parts list sorted as the browser pane.

[checkcheck_master]

Thanks a lot jjstr8 for your input.

Very educational again.
Getting bogged down in lists was to show how I came to things.
To be continued.

[checkcheck_master]

To be continued.

[checkcheck_master]

Nice code jjstr8, nice output too.
I've tried to understand and extend the code to be able to reposition and sort the Parts Only BOM as well.
I think that worked out pretty well, Purchased Assemblies are included and Phantom things are excluded.
Am I overlooking variants where it wouldn't work?

As I wrote, I would also really like to be able to reposition the Structured All Levels BOM.
You indicated that this is a thing, but do you think it is possible?
In my simplicity, looking at the output of your base code, that's the format it should come in.
Multiple components in the same level do not repeat and components that are used in multiple subs appear again and again in those subs.
Exactly the Structured list so to speak.

Just to be sure, is it possible to find and reassign the BOM row at the component?
Or, as someone suggested, is it possible to create a temporary Item Number, sort it and then equate it to the original Item Number and then delete it?
Or else?

See the code I made of it now, don't be scared, again with lists to get an overview and ideas for a hobbyist like me 🙂
Repositioning the structured 1st Level BOM isn't working right now, I've been too diligent in compiling the list.
Like I said, I'm trying to focus on All Levels for a while.

Public Class Variables

Dim List_Structured_1st_Level As New List(Of String)
Dim List_Structured_All_Levels As New List(Of String)
Dim List_Structured_Unique_All_Levels As New List(Of String)
Dim List_Parts_Only As New List(Of String)

Dim Level As Integer = 1

Sub Main
	If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then
		MsgBox("An Assembly Document must be active for this rule to work. Exiting.", vbCritical, "iLogic")
		Exit Sub
	End If
	'Dim oADoc As AssemblyDocument = ThisApplication.ActiveDocument
	Dim oADoc As AssemblyDocument = ThisDoc.Document
	oDef = oADoc.ComponentDefinition
	
'	If oADoc.ModelStateName <> "Master" Or _
'	oADoc.ComponentDefinition.IsModelStateMember Or _
'	oADoc.ComponentDefinition.IsModelStateFactory = False Then
'	oADoc = oADoc.ComponentDefinition.FactoryDocument
'	End If

	' Now get order needed for 'Structured' and 'Parts Only'
	' This function itterate the Browser Pane and fill lists List_Structured_Unique_All_Levels and List_Parts_Only

    Dim topNode = oADoc.BrowserPanes.Item("Model").TopNode
	Dim docs As New List(Of String)
	
	Logger.Info(vbNewLine & "---------------------------------------------------------------------------------------------------- START" & vbNewLine)
        Logger.Info("0|" & oADoc.FullFileName & Space(200-Len(oADoc.FullFileName)) & GetSubDocumentType(oADoc) &  "    " & GetBOMStructure(oDef.BOMStructure))
		Logger.Info("")
		GetBrowserNodes(topNode, docs, 0, "", 0)
	Logger.Info(vbNewLine & "---------------------------------------------------------------------------------------------------- END")
		
	' Show the results for checking or debuging
	Logger.Info(vbNewLine):Logger.Info("List_Structured_1st_Level: " & List_Structured_1st_Level.count):Logger.Info("") 
	For Each item In List_Structured_1st_Level 
		Logger.Info(item)
		Next
	
	Logger.Info(vbNewLine):Logger.Info("List_Structured_All_Levels: " & List_Structured_All_Levels.count):Logger.Info("") 
	For Each item In List_Structured_All_Levels 
		Logger.Info(item)			
	Next
	
	Logger.Info(vbNewLine):Logger.Info("List_Structured_Unique_All_Levels: " & List_Structured_Unique_All_Levels.count):Logger.Info("") 
	For Each item In List_Structured_Unique_All_Levels 
		Dim Xitem As Object = item
			Logger.Info(item)
		Next
	
	Logger.Info(vbNewLine):Logger.Info("List_Parts_Only: " & List_Parts_Only.count):Logger.Info("")
	For Each item In List_Parts_Only
		Logger.Info(item)
		Next

	' -------------------------------------------------------------------------------------------------
	Dim oBOM As BOM
	oBOM = oADoc.ComponentDefinition.BOM
	oBOM.StructuredViewEnabled = True
	oBOM.StructuredViewFirstLevelOnly = True '(was True)
	oView = oBOM.BOMViews.Item("Structured")
		
	' Now reposition rows to match needed order
	Logger.Info(vbNewLine)
	Logger.Info("Reposition Structured rows: ")
	For Each oRow As BOMRow In oView.BOMRows
		Try
			oCD = oRow.ComponentDefinitions.Item(1)
			Dim oRowDoc As Document = oCD.Document
			' Check what 'Index' this one is in our list
			' This returns a 'zero' based Integer, so first item is at position zero
			'oIndex = List_Structured_1st_Level.IndexOf(oRowDoc.FullFileName)
			'oIndex = List_Structured_Unique_All_Levels.IndexOf(oRowDoc.FullFileName)
			oIndex = List_Structured_1st_Level.indexof(oRowDoc.FullFileName)
						
			' We don't want to use zero as an ItemNumber, so add 1 to each Index
			Logger.Info(oRow.ItemNumber & "      Before renumbering - " & oRowDoc.FullFileName)
			oRow.ItemNumber = (oIndex + 1)
			Logger.Info(oRow.ItemNumber & "      After renumbering") '(oIndex)
		Catch oEx As Exception
			MsgBox("Encoutered Error trying to set new ItemNumber value to BOMRow." & vbCrLf & _
			oEx.Message & vbCrLf & oEx.StackTrace,,"")
		End Try
	Next
	Logger.Info("")
	' Sort the BOM rows by their ItemNumber column values now
	' So that they will all be in proper order afterwards
	' <<< If your ItemNumber column has a different Title, then change this >>>
	oView.Sort("Item", True)
	'oView.Renumber(1, 1)
	
	oBOM.StructuredViewFirstLevelOnly = False '(was True)
	
	' -------------------------------------------------------------------------------------------------
	Dim oBOM2 As BOM
	oBOM2 = oADoc.ComponentDefinition.BOM
	oBOM2.PartsOnlyViewEnabled = True
	oView2 = oBOM2.BOMViews.Item("Parts Only")
			
	' Now reposition rows to match needed order
	Logger.Info(vbNewLine)
	Logger.Info("Reposition Parts Only rows:")
	For Each oRow2 As BOMRow In oView2.BOMRows
		Try
			oCD2 = oRow2.ComponentDefinitions.Item(1)
			Dim oRowDoc2 As Document = oCD2.Document
			' Check what 'Index' this one is in our list
			' This returns a 'zero' based Integer, so first item is at position zero
			oIndex2 = List_Parts_Only.IndexOf(oRowDoc2.FullFileName)
			
			' We don't want to use zero as an ItemNumber, so add 1 to each Index
			Logger.Info(oRow2.ItemNumber & "      Before renumbering")
			oRow2.ItemNumber = (oIndex2 + 1)
			Logger.Info(oRow2.ItemNumber & "      After renumbering") '(oIndex2)
		Catch oEx As Exception
			MsgBox("Encoutered Error trying to set new ItemNumber value to BOMRow." & vbCrLf & _
			oEx.Message & vbCrLf & oEx.StackTrace,,"")
		End Try
	Next
	Logger.Info("")
	' Sort the BOM rows by their ItemNumber column values now
	' So that they will all be in proper order afterwards
	' <<< If your ItemNumber column has a different Title, then change this >>>
	oView2.Sort("Item", True)
	'oView2.Renumber(1, 1)

End Sub

Public Function GetBrowserNodes(node As BrowserNode, docs As List(Of String), parentLevel As Integer, parentItemNumber As String, lastNumber As Integer) As Integer
	Dim newOccurrence As ComponentOccurrence
	Dim itemNumber As Integer = 1
	Dim itemString As String
	Dim splitChar As Char() = {"|"c}
	Dim splitString As String()
	Dim duplicate As Boolean
	Dim recurseResult As Integer
	
	'Check if we're in a pattern or folder so the item number continues sequence
	If (lastNumber > 0) Then
		itemNumber = lastNumber
	End If

    For Each subNode As BrowserNode In node.BrowserNodes
        Try
            If (TypeOf subNode.NativeObject Is ComponentOccurrence) Then
				newOccurrence = subNode.NativeObject
				If (parentLevel = 0) Then
					itemString = itemNumber.ToString()
				Else
					itemString = parentItemNumber & "." & itemNumber.ToString()
				End If
				
				'Check the list for duplicates
				duplicate = False
				If (docs.Count > 0) Then
					For i = 0 To docs.Count - 1
						splitString = docs(i).Split(splitChar)
						If ((splitString(1) = newOccurrence.Definition.Document.FullFileName) And docs(i).StartsWith(parentItemNumber)) Then
							'Logger.Info("Duplicate: " & newOccurrence.Definition.Document.FullFileName)
							duplicate = True
							Exit For
						End If					
				Next
				End If
				
				'Add the document name to the list with item numbering as a prefix
				If Not (duplicate) Then
					
					' Get Document SubType
            		Dim oDocType As String
            		oDocType = GetSubDocumentType(newOccurrence.Definition.Document)
					'Logger.Info(oDoc.DocumentType)
					            							
					fileName = newOccurrence.Definition.Document.FullFileName
					
					docs.Add(itemString & "|" & newOccurrence.Definition.Document.FullFileName)
					List_Structured_All_Levels.add(newOccurrence.Definition.Document.FullFileName)
					Logger.Info(itemString & "|" & newOccurrence.Definition.Document.FullFileName  & Space(200-Len(fileName)) & oDocType & "     " & newOccurrence.Definition.BOMStructure.tostring)
															
						'----------------------------------------------------------------------------------------------------
						' By CheckMaster
						' Fill List_Structured_1st_Level
						If Not itemString Like "*.*" And Not newOccurrence.Definition.BOMStructure = BOMStructureEnum.kPhantomBOMStructure Then 
								If Not List_Structured_1st_Level.contains(newOccurrence.Definition.Document.FullFileName) Then
									List_Structured_1st_Level.Add(newOccurrence.Definition.Document.FullFileName)
									'Logger.Info(newOccurrence.Definition.Document.FullFileName)
								End If
						End If
								
						' Fill List_Structured_Unique_All_Levels
						If Not newOccurrence.Definition.BOMStructure = BOMStructureEnum.kPhantomBOMStructure Then 
							If Not List_Structured_Unique_All_Levels.Contains(newOccurrence.Definition.Document.FullFileName) Then
									List_Structured_Unique_All_Levels.Add(newOccurrence.Definition.Document.FullFileName)
									'Logger.Info(newOccurrence.Definition.Document.FullFileName)
							End If
						End If
						
						' Fill List_Parts_Only						
						If newOccurrence.DefinitionDocumentType = DocumentTypeEnum.kPartDocumentObject Or newOccurrence.Definition.BOMStructure = BOMStructureEnum.kPurchasedBOMStructure Then
							If Not newOccurrence.Definition.BOMStructure = BOMStructureEnum.kPhantomBOMStructure Then
								If Not List_Parts_Only.Contains(newOccurrence.Definition.Document.FullFileName) Then
									List_Parts_Only.Add(newOccurrence.Definition.Document.FullFileName)
									'Logger.Info(newOccurrence.Definition.Document.FullFileName)
								End If
							End If
						End If
					
					
					'Drill into sub-assemblies
					If (subNode.NativeObject.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject) Then
						'Logger.Info("Recursing " & newOccurrence.Definition.Document.DisplayName)
						recurseResult = GetBrowserNodes(subNode, docs, parentLevel + 1, itemString, 0)
						Logger.Info("")
					End If
					itemNumber = itemNumber + 1
				End If
				Continue For
            End If
			
			'Look for sub-nodes that still belong to the parent level
            If ((TypeOf subNode.NativeObject Is OccurrencePattern) Or (TypeOf subNode.NativeObject Is OccurrencePatternElement) Or _
				(TypeOf subNode.NativeObject Is BrowserFolder)) Then
				'Logger.Info("Recursing pattern or folder")
                recurseResult = GetBrowserNodes(subNode, docs, parentLevel, parentItemNumber, itemNumber)
				If (recurseResult > 0) Then
					itemNumber = recurseResult
				End If
            End If
        Catch ex As Exception
			MessageBox.Show(ex.Message)
        End Try
    Next
	
	'If we were in a pattern or folder, return the last item number used
	If (lastNumber > 0) Then
		Return itemNumber
	Else
		Return 0
	End If
	
End Function

Public Function GetSubDocumentType(oDocFromSub As Document) As String

'    ' Access the active document
'    'Dim oDoc As Document
'    'Set oDoc = ThisApplication.ActiveDocument
'    'Set oDoc = oOcc.Definition.Document
'    'oDoc = oDocFromSub

    ' Get the document type
    Dim eDocumentType As DocumentTypeEnum
    eDocumentType = oDocFromSub.DocumentType

    Dim sDocumentType As String
	
	'Logger.Info(eDocumentType)

    Select Case eDocumentType:
        Case DocumentTypeEnum.kAssemblyDocumentObject
            sDocumentType = "Assembly_Document"
        Case DocumentTypeEnum.kDesignElementDocumentObject
            sDocumentType = "DesignElement_Document"
        Case DocumentTypeEnum.kDrawingDocumentObject
            sDocumentType = "Drawing_Document"
        Case DocumentTypeEnum.kForeignModelDocumentObject
            sDocumentType = "ForeignModel_Document"
        Case DocumentTypeEnum.kPartDocumentObject
            sDocumentType = "Part_Document"
        Case DocumentTypeEnum.kPresentationDocumentObject
            sDocumentType = "Presentation_Document"
        Case DocumentTypeEnum.kSATFileDocumentObject
            sDocumentType = "SATFile_Document"
        Case DocumentTypeEnum.kUnknownDocumentObject
            sDocumentType = "Unknown_Document"
    End Select

    ' Get the document Sub-Type
    Dim sDocumentSubType As String
    sDocumentSubType = oDocFromSub.SubType
    Dim sReadableType As String

    Select Case sDocumentSubType:
        ' Part document sub-types
        Case "{4D29B490-49B2-11D0-93C3-7E0706000000}"
            sReadableType = "Part       "
        ' Sheet metal
        Case "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
            sReadableType = "Sheet_metal"
        ' Generic proxy
        Case "{92055419-B3FA-11D3-A479-00C04F6B9531}"
            sReadableType = "Generic_proxy"
        ' Compatibility proxy
        Case "{9C464204-9BAE-11D3-8BAD-0060B0CE6BB4}"
            sReadableType = "Compatibility_proxy"
        ' Catalog proxy
        Case "{9C88D3AF-C3EB-11D3-B79E-0060B0F159EF}"
            sReadableType = "Catalog_proxy"

        ' Assembly document sub-types
        Case "{E60F81E1-49B3-11D0-93C3-7E0706000000}"
            sReadableType = "Assembly"
        Case "{28EC8354-9024-440F-A8A2-0E0E55D635B0}"  ' Stands for Weldassy
            sReadableType = "Weld_assembly"

        ' Drawing document sub-types
        Case "{BBF9FDF1-52DC-11D0-8C04-0800090BE8EC}"
            sReadableType = "Drawing"

        ' Design element document sub-types
        Case "{62FBB030-24C7-11D3-B78D-0060B0F159EF}"
            sReadableType = "Design_element"

        ' Presentation document sub-types
        Case "{76283A80-50DD-11D3-A7E3-00C04F79D7BC}"
            sReadableType = "Presentation"
    End Select
    
    'MsgBox ("Document Type: " & sDocumentType & vbNewLine & "Document SubType: " + sReadableType)

    GetSubDocumentType = sDocumentType & " - " & sReadableType
    'MsgBox GetSubDocumentType

End Function

Public Function GetBOMStructure(BOMStructureFromDoc) As String

    Select Case BOMStructureFromDoc:
        Case 51969 ' kDefaultBOMStructure
            sBOMStructure = "kDefaultBOMStructure"
        Case 51974 ' kInseparableBOMStructure
            sBOMStructure = "kInseparableBOMStructure"
        Case 51970 ' kNormalBOMStructure
            sBOMStructure = "kNormalBOMStructure"
        Case 51971 ' kPhantomBOMStructure
            sBOMStructure = "kPhantomBOMStructure"
        Case 51973 ' kPurchasedBOMStructure
            sBOMStructure = "kPurchasedBOMStructure"
        Case 51972 ' kReferenceBOMStructure
            sBOMStructure = "kReferenceBOMStructure"
        Case 51975 ' kVariesBOMStructure
            sBOMStructure = "kVariesBOMStructure"
    End Select
    
    GetBOMStructure = sBOMStructure

' Name                      Value   Description
' kDefaultBOMStructure      51969   The default structure type.
' kInseparableBOMStructure  51974   The inseparable structure type.
' kNormalBOMStructure       51970   The normal structure type.
' kPhantomBOMStructure      51971   The phantom structure type.
' kPurchasedBOMStructure    51973   The purchased structure type.
' kReferenceBOMStructure    51972   The reference structure type.
' kVariesBOMStructure       51975   The structure type varies amongst references.

End Function













Public Function GetModelsRecursive(node As BrowserNode) As List(Of BrowserNode)
    Dim nodes As New List(Of BrowserNode)	
	'Level = 1
    For Each subNode As BrowserNode In node.BrowserNodes
        Try
            If (TypeOf subNode.NativeObject Is ComponentOccurrence) Then
                				
				Dim occ As ComponentOccurrence = subNode.NativeObject
            	Dim oDoc As Document = occ.Definition.Document
            	Dim fileName = oDoc.FullFileName
				
				logger.Info("Level: " & Level)
				
				' Fill List_Structured_1st_Level
				If Not List_Structured_1st_Level.Contains(fileName) And Level = 1 Then
						List_Structured_1st_Level.Add(fileName)
						'Logger.Info(fileName)
					End If
								
				' Fill List_Structured_Unique_All_Levels
				If Not List_Structured_Unique_All_Levels.Contains(fileName) Then
						List_Structured_Unique_All_Levels.Add(fileName)
						'Logger.Info(fileName)
					End If
				
				' Fill List_Parts_Only
				If subNode.NativeObject.DefinitionDocumentType = DocumentTypeEnum.kPartDocumentObject Or occ.Definition.BOMStructure = BOMStructureEnum.kPurchasedBOMStructure Then
					If Not List_Parts_Only.Contains(fileName) Then
						List_Parts_Only.Add(fileName)
						'Logger.Info(fileName)
					End If
				End If
				
				nodes.Add(subNode)
                nodes.AddRange(GetModelsRecursive(subNode))				
			End If
            
			If (TypeOf subNode.NativeObject Is OccurrencePattern) Then
                nodes.AddRange(GetModelsRecursive(subNode))
				
            End If
            
			If (TypeOf subNode.NativeObject Is OccurrencePatternElement) Then
                nodes.AddRange(GetModelsRecursive(subNode))
				
            End If
        
		Catch ex As Exception
        End Try
	Next
    Return nodes
	
End Function

End Class

[jjstr8]

The only other variant I could think of is inseparable assemblies, but those look okay.  Your code for 1st level worked for me on a test assembly, so I'm not sure what you're running into. 

Yes, it is entirely possible to do this for an "all levels" BOM.  The one gotcha I could think of is when you have merged rows.  In that situation, two separate browser nodes would reference a single BOM row.  I'll leave it to you on how to handle that.  It may be as simple as always using ComponentDefinitions(1) for a given BOM row.  I still think re-assigning the item numbers followed by a sort is the simplest approach.  Here's my thoughts on handling the "all levels" BOM.

• When searching the output from the browser nodes list, use the String.Split function to your advantage.  Split the string with the pipe character to get the new item number and its full file name.  Since full file names are unique, that's all you need to start matching with a BOM row.
• You can also split the new item number with a decimal point character to get the item number levels broken down.  The count of the string list return tells you the item's level.  This may or may not be of use to you.
• Your function that recursively goes through the BOM rows should have a string parameter passed in that lets you know what an item number should start with when you're in a sub-assembly.  For example, if you're going to drill down in a sub-assembly whose item number is "2" (or deeper levels), then when you search the browser nodes to match each BOM row, the item number string must start with "2".  This handles cases where the same part is used in multiple assemblies.  At the top level, just pass in a "" and ignore your String.StartsWith code in those cases.