Sub-Assembly Quantity in List

[kwarrenH4ZT3]

I've got code that goes through an assembly and finds all of the documents with a certain property set. It then adds it to a list with the stock number, file path, and qty. The issue I'm running into is if there is a main assembly (Call it A) with multiple sub assemblies (Call it B) it will show the amount required for that sub assembly but if sub assembly B has another sub assembly (call it B.1) it doesn't multiply the quantity required just shows the total quantity required for one B assembly. It also doesn't account if sub C is in other sub assemblies. Below is a snippet of the code I have that

Private Function GetBOMstructure(ByVal oBOM As BOM) As BOMView
	Dim sLanguageBOM, sSortItem As String
	Select Case ThisApplication.LanguageCode
		Case "en-US"
			sLanguageBOM = "Structured"
		Case Else
			Return Nothing
	End Select
	If oBOM.StructuredViewEnabled = False Then oBOM.StructuredViewEnabled = True
	If oBOM.StructuredViewFirstLevelOnly = True Then oBOM.StructuredViewFirstLevelOnly = False
	Return oBOM.BOMViews.Item(sLanguageBOM)
End Function

Private Function GetListComponents(ByVal oBOMRows As BOMRowsEnumerator, ByRef oListComp As Object)
	Dim oCompDef As ComponentDefinition

	For Each oRow As BOMRow In oBOMRows
		oCompDef = oRow.ComponentDefinitions.Item(1)
		Dim oDoc As Document = oCompDef.Document

		If oDoc.PropertySets.Item("Design Tracking Properties").Item("Cost Center").Value = "ACC" Then

			Dim sStokNumb As String = oDoc.PropertySets.Item("Design Tracking Properties").Item("Stock Number").Value
			'Dim folderpath As String = oDoc.PropertySets.Item("Design Tracking Properties").Item("Location").Value
			Dim folderpath As String = oDoc.File.FullFileName
			'defines backslash as the subdirectory separator
			Dim strCharSep As String = System.IO.Path.DirectorySeparatorChar
			'find the postion of the last backslash in the path
			FNamePos = InStrRev(folderpath, "\", -1)
			'get the file name with the file extension
			Name = Right(folderpath, Len(folderpath) -FNamePos)
			'get the path of the folder containing the file
			Folder_Location = Left(folderpath, Len(folderpath) -Len(Name) -1)
			'Sets export location for batch plot pdf location
			Dim FilePath As String = "X:\7 - Design\0 - Batch Plot Drawings\" + Folder_Location.Substring(16)

			Dim NewFilePath As String = FilePath + "\"
			'i = MessageBox.Show("The Value you entered was incorrect " & NewFilePath, "My iLogic Dialog", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1)
			'Used if folder isn't in right location
			
			Else
		
	
				oListComp(sStokNumb + NewFilePath) = oListComp(sStokNumb + NewFilePath) + oRow.ItemQuantity
		

		End If
		
		If oRow.ChildRows IsNot Nothing Then
			GetListComponents(oRow.ChildRows, oListComp)
		End If
	Next
End Function

[WCrihfield]

Hi @kwarrenH4ZT3.  It seems clear that the code you posted is just part of a larger block of code, because there  does not appear to be a Sub Main or  a declaration line for the oListComp variable.  Have you considered using the ComponentOccurrences.AllReferencedComponents(Object) method?  You can supply a DocumentDescriptor, ComponentOccurrence, or Document as input, and it will return a ComponentOccurrencesEnumerator containing every component that references the input.  You may be able to use that from the top/main assembly's AssemblyComponentDefinition.Occurrences property, and it will reach every level of the assembly.  Then you could iterate the components in the returned collection to gather the needed data.  Just one thought that crossed my mind when I read your post.  

[kwarrenH4ZT3]

@WCrihfield Yes Below is the full code. I can look into using the all referenced components. If I used the all referenced components would it also take include any of the files that the bom structure is set to reference? We do use reference a lot and the iLogic I have right now doesn't include the reference files which I want to keep that way. I'm sure I could set it to exclude any with the bom structure of reference.

Sub Main()
Dim oDoc As Document = ThisApplication.ActiveDocument
Dim oDrawDoc As DrawingDocument = oDoc
Dim oSheet As Sheet = oDrawDoc.Sheets.Item(1)
oRevTableDateColumn = 1
If oSheet.RevisionTables.Count > 0
	Dim oTable As RevisionTable = oSheet.RevisionTables.Item(1)
	Dim oRows As RevisionTableRows = oTable.RevisionTableRows
	Dim oRow As RevisionTableRow = oRows.Item(oRows.Count)
	RevCheck = oRow.Item(oRevTableDateColumn).Text
Else
	i = MessageBox.Show("Place a revision table!", "Need Revision Table", MessageBoxButtons.OK, MessageBoxIcon.Warning, MessageBoxDefaultButton.Button1)
	Return
End If

If TypeOf oDoc Is DrawingDocument Then
	If oSheet.DrawingViews.Count <> 0 Then
		Dim oView As DrawingView = oSheet.DrawingViews.Item(1)
		Dim oRefDoc As Document = oView.ReferencedDocumentDescriptor.ReferencedDocument
		If TypeOf oRefDoc Is AssemblyDocument Then
			Dim oAssDoc As AssemblyDocument = oRefDoc
			Dim oBOM As BOM = oAssDoc.ComponentDefinition.BOM
			Dim oBOMView As BOMView = GetBOMstructure(oBOM)
			If oBOMView Is Nothing Then Exit Sub
			Dim oListComp As Object = CreateObject("Scripting.Dictionary")
			Call GetListComponents(oBOMView.BOMRows, oListComp)
			Dim sNameTable As String = "ACC LIST - " & System.IO.Path.GetFileNameWithoutExtension(oAssDoc.FullDocumentName)
			Call CreatTable(oSheet, oListComp, sNameTable)
			Call ExportList(RevCheck, sNameTable)
			Call PID(RevCheck, sNameTable)
		Else
			MessageBox.Show("A table can only be created for AssemblyDocument.", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Error)
		End If
	Else
		MessageBox.Show("There are no DrawingViews on the first sheet.", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Error)
	End If
Else
	MessageBox.Show("Active document is not Drawing Document.", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
Events()
End Sub

Private Function GetBOMstructure(ByVal oBOM As BOM) As BOMView
	Dim sLanguageBOM, sSortItem As String
	Select Case ThisApplication.LanguageCode
		Case "en-US"
			sLanguageBOM = "Structured"
		Case Else
			Return Nothing
	End Select
	If oBOM.StructuredViewEnabled = False Then oBOM.StructuredViewEnabled = True
	If oBOM.StructuredViewFirstLevelOnly = True Then oBOM.StructuredViewFirstLevelOnly = False
	Return oBOM.BOMViews.Item(sLanguageBOM)
End Function

Private Function GetListComponents(ByVal oBOMRows As BOMRowsEnumerator, ByRef oListComp As Object)
	Dim oCompDef As ComponentDefinition

	For Each oRow As BOMRow In oBOMRows
		oCompDef = oRow.ComponentDefinitions.Item(1)
		Dim oDoc As Document = oCompDef.Document

		If oDoc.PropertySets.Item("Design Tracking Properties").Item("Cost Center").Value = "ACC" Then

			Dim sStokNumb As String = oDoc.PropertySets.Item("Design Tracking Properties").Item("Stock Number").Value
			'Dim folderpath As String = oDoc.PropertySets.Item("Design Tracking Properties").Item("Location").Value
			Dim folderpath As String = oDoc.File.FullFileName
			'defines backslash as the subdirectory separator
			Dim strCharSep As String = System.IO.Path.DirectorySeparatorChar
			'find the postion of the last backslash in the path
			FNamePos = InStrRev(folderpath, "\", -1)
			'get the file name with the file extension
			Name = Right(folderpath, Len(folderpath) -FNamePos)
			'get the path of the folder containing the file
			Folder_Location = Left(folderpath, Len(folderpath) -Len(Name) -1)
			'Sets export location for batch plot pdf location
			Dim FilePath As String = "X:\7 - Design\0 - Batch Plot Drawings\" + Folder_Location.Substring(16)

			Dim NewFilePath As String = FilePath + "\"
			'i = MessageBox.Show("The Value you entered was incorrect " & NewFilePath, "My iLogic Dialog", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1)
			'Used if folder isn't in right location
		If Not oListComp(sStokNumb + NewFilePath).exists(sStokNumb) Then
			oRow = oRow + oRow.ItemQuantity
'			oListComp(sStokNumb + NewFilePath).add.oRow.ItemQuanity
			Else
		
				oListComp(sStokNumb + NewFilePath) = oListComp(sStokNumb + NewFilePath) + oRow.ItemQuantity

		End If
		End If
		
		If oRow.ChildRows IsNot Nothing Then
			GetListComponents(oRow.ChildRows, oListComp)
		End If
	Next
End Function

Private Function CreatTable(ByVal oSheet As Sheet, ByVal oListComp As Object, ByVal sNameTable As String)
	Dim oCustomTable As CustomTable
	For Each otable As CustomTable In oSheet.CustomTables
		If otable.Title = sNameTable Then
			oCustomTable = otable
		End If
	Next
	If oCustomTable Is Nothing Then
		Dim oTitles(3) As String
		oTitles(0) = "ACC #"
		oTitles(1) = "STOCK NUMBER"
		oTitles(2) = "QTY"
		oTitles(3) = "HYPERLINK"
		Dim oPlacementPoint As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(.9525, 14.6288)
		oCustomTable = oSheet.CustomTables.Add(sNameTable, oPlacementPoint, 4, oListComp.Count, oTitles)
		oCustomTable.Columns.Item(1).Width = 2
		oCustomTable.Columns.Item(2).Width = 6
		oCustomTable.Columns.Item(3).Width = 2
		oCustomTable.Columns.Item(4).Width = .001
		oCustomTable.ShowTitle = True
		'oCustomTable.TableDirection = kBottomUpDirection
		'oCustomTable.HeadingPlacement = kHeadingAtBottom
		oCustomTable.WrapAutomatically = False
		'oCustomTable.MaximumRows=30
		oHeightCustomTable = oCustomTable.RangeBox.MaxPoint.Y - oCustomTable.RangeBox.MinPoint.Y
		oTablePt = ThisApplication.TransientGeometry.CreatePoint2d(.9525, oHeightCustomTable + .9525)
		oCustomTable.Position = oTablePt
	Else
		If oCustomTable.Rows.Count < oListComp.Count Then
			For i = oCustomTable.Rows.Count + 1 To oListComp.Count
				oCustomTable.Rows.Add()
			Next i
			oHeightCustomTable = oCustomTable.RangeBox.MaxPoint.Y - oCustomTable.RangeBox.MinPoint.Y
			oTablePt = ThisApplication.TransientGeometry.CreatePoint2d(.9525, oHeightCustomTable + .9525)
			oCustomTable.Position = oTablePt
		Else If oCustomTable.Rows.Count > oListComp.Count Then
		For i = oCustomTable.Rows.Count To oListComp.Count + 1 Step -1
			oCustomTable.Rows.Item(i).Delete()
		Next i
		oHeightCustomTable = oCustomTable.RangeBox.MaxPoint.Y - oCustomTable.RangeBox.MinPoint.Y
		oTablePt = ThisApplication.TransientGeometry.CreatePoint2d(.9525, oHeightCustomTable + .9525)
		oCustomTable.Position = oTablePt
	End If
	End If
	Dim iList As Long = 1
	For Each Item In oListComp
		oCustomTable.Rows.Item(iList).Item(1).Value = iList
		oCustomTable.Rows.Item(iList).Item(2).Value = Item.Substring(0, Item.IndexOf("X:\"))
		oCustomTable.Rows.Item(iList).Item(3).Value = oListComp(Item)
		oCustomTable.Rows.Item(iList).Item(4).Value = Item.Remove(0, Item.IndexOf("X:\"))
		iList += 1
	Next
End Function

[Andrii_Humeniuk]

Hi @kwarrenH4ZT3 . I recognize this code, but I see you've added a lot of changes. I reworked the GetListComponents() function as written by Mr. @WCrihfield above. I hope this is exactly what you needed.

Sub Main()
Dim oDoc As Document = ThisApplication.ActiveDocument
Dim oDrawDoc As DrawingDocument = oDoc
Dim oSheet As Sheet = oDrawDoc.Sheets.Item(1)
oRevTableDateColumn = 1
If oSheet.RevisionTables.Count > 0
	Dim oTable As RevisionTable = oSheet.RevisionTables.Item(1)
	Dim oRows As RevisionTableRows = oTable.RevisionTableRows
	Dim oRow As RevisionTableRow = oRows.Item(oRows.Count)
	RevCheck = oRow.Item(oRevTableDateColumn).Text
Else
	i = MessageBox.Show("Place a revision table!", "Need Revision Table", MessageBoxButtons.OK, MessageBoxIcon.Warning, MessageBoxDefaultButton.Button1)
	Return
End If

If TypeOf oDoc Is DrawingDocument Then
	If oSheet.DrawingViews.Count <> 0 Then
		Dim oView As DrawingView = oSheet.DrawingViews.Item(1)
		Dim oRefDoc As Document = oView.ReferencedDocumentDescriptor.ReferencedDocument
		If TypeOf oRefDoc Is AssemblyDocument Then
			Dim oAssDoc As AssemblyDocument = oRefDoc
			Dim oListComp As Object = CreateObject("Scripting.Dictionary")
			Dim oOccs As ComponentOccurrences = oAssDoc.ComponentDefinition.Occurrences
			For Each oRefDoc In oAssDoc.AllReferencedDocuments
				Dim iQ As Integer = oOccs.AllReferencedOccurrences(oRefDoc).Count
				If iQ = 0 Then Continue For
				Call GetListComponents(oRefDoc, iQ, oListComp)
			Next
			Dim sNameTable As String = "ACC LIST - " & System.IO.Path.GetFileNameWithoutExtension(oAssDoc.FullDocumentName)
			Call CreatTable(oSheet, oListComp, sNameTable)
			Call ExportList(RevCheck, sNameTable)
			Call PID(RevCheck, sNameTable)
		Else
			MessageBox.Show("A table can only be created for AssemblyDocument.", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Error)
		End If
	Else
		MessageBox.Show("There are no DrawingViews on the first sheet.", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Error)
	End If
Else
	MessageBox.Show("Active document is not Drawing Document.", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
Events()
End Sub

Private Function GetListComponents(ByVal oDoc As Document, ByVal iQ As Integer, ByRef oListComp As Object)
	Dim oDesign As PropertySet = oDoc.PropertySets("Design Tracking Properties")
	If oDesign("Cost Center").Value <> "ACC" Then Exit Function
	Dim sStokNumb As String = oDesign("Stock Number").Value
	'Dim folderpath As String = oDoc.PropertySets.Item("Design Tracking Properties").Item("Location").Value
	Dim folderpath As String = oDoc.File.FullFileName
	'defines backslash as the subdirectory separator
	Dim strCharSep As String = System.IO.Path.DirectorySeparatorChar
	'find the postion of the last backslash in the path
	FNamePos = InStrRev(folderpath, "\", -1)
	'get the file name with the file extension
	Name = Right(folderpath, Len(folderpath) -FNamePos)
	'get the path of the folder containing the file
	Folder_Location = Left(folderpath, Len(folderpath) -Len(Name) -1)
	'Sets export location for batch plot pdf location
	Dim NewFilePath As String = "X:\7 - Design\0 - Batch Plot Drawings\" + Folder_Location.Substring(16) + "\"
	oListComp(sStokNumb + NewFilePath) = oListComp(sStokNumb + NewFilePath) + iQ
End Function

Private Function CreatTable(ByVal oSheet As Sheet, ByVal oListComp As Object, ByVal sNameTable As String)
	Dim oCustomTable As CustomTable
	For Each otable As CustomTable In oSheet.CustomTables
		If otable.Title = sNameTable Then
			oCustomTable = otable
		End If
	Next
	If oCustomTable Is Nothing Then
		Dim oTitles(3) As String
		oTitles(0) = "ACC #"
		oTitles(1) = "STOCK NUMBER"
		oTitles(2) = "QTY"
		oTitles(3) = "HYPERLINK"
		Dim oPlacementPoint As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(.9525, 14.6288)
		oCustomTable = oSheet.CustomTables.Add(sNameTable, oPlacementPoint, 4, oListComp.Count, oTitles)
		oCustomTable.Columns.Item(1).Width = 2
		oCustomTable.Columns.Item(2).Width = 6
		oCustomTable.Columns.Item(3).Width = 2
		oCustomTable.Columns.Item(4).Width = .001
		oCustomTable.ShowTitle = True
		'oCustomTable.TableDirection = kBottomUpDirection
		'oCustomTable.HeadingPlacement = kHeadingAtBottom
		oCustomTable.WrapAutomatically = False
		'oCustomTable.MaximumRows=30
		oHeightCustomTable = oCustomTable.RangeBox.MaxPoint.Y - oCustomTable.RangeBox.MinPoint.Y
		oTablePt = ThisApplication.TransientGeometry.CreatePoint2d(.9525, oHeightCustomTable + .9525)
		oCustomTable.Position = oTablePt
	Else
		If oCustomTable.Rows.Count < oListComp.Count Then
			For i = oCustomTable.Rows.Count + 1 To oListComp.Count
				oCustomTable.Rows.Add()
			Next i
			oHeightCustomTable = oCustomTable.RangeBox.MaxPoint.Y - oCustomTable.RangeBox.MinPoint.Y
			oTablePt = ThisApplication.TransientGeometry.CreatePoint2d(.9525, oHeightCustomTable + .9525)
			oCustomTable.Position = oTablePt
		Else If oCustomTable.Rows.Count > oListComp.Count Then
		For i = oCustomTable.Rows.Count To oListComp.Count + 1 Step -1
			oCustomTable.Rows.Item(i).Delete()
		Next i
		oHeightCustomTable = oCustomTable.RangeBox.MaxPoint.Y - oCustomTable.RangeBox.MinPoint.Y
		oTablePt = ThisApplication.TransientGeometry.CreatePoint2d(.9525, oHeightCustomTable + .9525)
		oCustomTable.Position = oTablePt
	End If
	End If
	Dim iList As Long = 1
	For Each Item In oListComp
		oCustomTable.Rows.Item(iList).Item(1).Value = iList
		oCustomTable.Rows.Item(iList).Item(2).Value = Item.Substring(0, Item.IndexOf("X:\"))
		oCustomTable.Rows.Item(iList).Item(3).Value = oListComp(Item)
		oCustomTable.Rows.Item(iList).Item(4).Value = Item.Remove(0, Item.IndexOf("X:\"))
		iList += 1
	Next
End Function

[kwarrenH4ZT3]

@Andrii_Humeniuk This works great the only issue I have is if I set an assembly to reference it still counts it in the list. Is there a way I can get it to not count any occurrence that has the bom structure set to reference? Other then that it works great!

[Andrii_Humeniuk]

You need to add this line of code between lines 47-48.

If oDoc.ComponentDefinition.BOMStructure = kReferenceBOMStructure Then Exit Function

[kwarrenH4ZT3]

@Andrii_Humeniuk  If I change the BOM Structure from the main assembly for individual assemblies it still counts all that are placed in the assembly. 

[Andrii_Humeniuk]

Hi @kwarrenH4ZT3 . Now I modified the GetListComponents() function to work with Occurrences. Note that the current Occurrence check on lines 45-47 uses a GoTo statement to be able to process components in the middle of the current Occurrence, if you need to skip it and not read the components in the subassembly you need to replace GoTo SkipWritingList with Continue For

Sub Main()
Dim oDoc As Document = ThisApplication.ActiveDocument
Dim oDrawDoc As DrawingDocument = oDoc
Dim oSheet As Sheet = oDrawDoc.Sheets.Item(1)
oRevTableDateColumn = 1
If oSheet.RevisionTables.Count > 0
	Dim oTable As RevisionTable = oSheet.RevisionTables.Item(1)
	Dim oRows As RevisionTableRows = oTable.RevisionTableRows
	Dim oRow As RevisionTableRow = oRows.Item(oRows.Count)
	RevCheck = oRow.Item(oRevTableDateColumn).Text
Else
	i = MessageBox.Show("Place a revision table!", "Need Revision Table", MessageBoxButtons.OK, MessageBoxIcon.Warning, MessageBoxDefaultButton.Button1)
	Return
End If

If TypeOf oDoc Is DrawingDocument Then
	If oSheet.DrawingViews.Count <> 0 Then
		Dim oView As DrawingView = oSheet.DrawingViews.Item(1)
		Dim oRefDoc As Document = oView.ReferencedDocumentDescriptor.ReferencedDocument
		If TypeOf oRefDoc Is AssemblyDocument Then
			Dim oAssDoc As AssemblyDocument = oRefDoc
			Dim oListComp As New Dictionary(Of String, Integer)
			Dim oOccs As ComponentOccurrences = oAssDoc.ComponentDefinition.Occurrences
			Call GetListComponents(oOccs, oListComp)
			Dim sNameTable As String = "ACC LIST - " & System.IO.Path.GetFileNameWithoutExtension(oAssDoc.FullDocumentName)
			Call CreatTable(oSheet, oListComp, sNameTable)
			Call ExportList(RevCheck, sNameTable)
			Call PID(RevCheck, sNameTable)
		Else
			MessageBox.Show("A table can only be created for AssemblyDocument.", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Error)
		End If
	Else
		MessageBox.Show("There are no DrawingViews on the first sheet.", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Error)
	End If
Else
	MessageBox.Show("Active document is not Drawing Document.", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
Events()
End Sub

Private Function GetListComponents(ByVal oOccs As ComponentOccurrences, ByRef oListComp As Dictionary(Of String, Integer))
	For Each oOcc As ComponentOccurrence In oOccs
		Dim oDoc As Document = oOcc.Definition.Document
		Dim oDesign As PropertySet = oDoc.PropertySets("Design Tracking Properties")
		If oOcc.BOMStructure = BOMStructureEnum.kReferenceBOMStructure Or
			oOcc.Definition.BOMStructure = BOMStructureEnum.kReferenceBOMStructure Or
			oDesign("Cost Center").Value <> "ACC" Then GoTo SkipWritingList
		Dim sStokNumb As String = oDesign("Stock Number").Value
		'Dim folderpath As String = oDoc.PropertySets.Item("Design Tracking Properties").Item("Location").Value
		Dim folderpath As String = oDoc.File.FullFileName
		'defines backslash as the subdirectory separator
		Dim strCharSep As String = System.IO.Path.DirectorySeparatorChar
		'find the postion of the last backslash in the path
		FNamePos = InStrRev(folderpath, "\", -1)
		'get the file name with the file extension
		Name = Right(folderpath, Len(folderpath) -FNamePos)
		'get the path of the folder containing the file
		Folder_Location = Left(folderpath, Len(folderpath) -Len(Name) -1)
		'Sets export location for batch plot pdf location
		Dim NewFilePath As String = "X:\7 - Design\0 - Batch Plot Drawings\" + Folder_Location.Substring(16) + "\"
		If oListComp.ContainsKey(sStokNumb & NewFilePath) Then
			oListComp(sStokNumb & NewFilePath) = oListComp(sStokNumb & NewFilePath) + 1
		Else
			oListComp.Add(sStokNumb & NewFilePath, 1)
		End If
		SkipWritingList :
		If oOcc.SubOccurrences IsNot Nothing Then
			If oOcc.SubOccurrences.Count <> 0 Then Call GetListComponents(oOcc.SubOccurrences, oListComp)
		End If
	Next
End Function

Private Function CreatTable(ByVal oSheet As Sheet, ByVal oListComp As Dictionary(Of String, Integer), ByVal sNameTable As String)
	Dim oCustomTable As CustomTable
	For Each otable As CustomTable In oSheet.CustomTables
		If otable.Title = sNameTable Then
			oCustomTable = otable
		End If
	Next
	If oCustomTable Is Nothing Then
		Dim oTitles(3) As String
		oTitles(0) = "ACC #"
		oTitles(1) = "STOCK NUMBER"
		oTitles(2) = "QTY"
		oTitles(3) = "HYPERLINK"
		Dim oPlacementPoint As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(.9525, 14.6288)
		oCustomTable = oSheet.CustomTables.Add(sNameTable, oPlacementPoint, 4, oListComp.Count, oTitles)
		oCustomTable.Columns.Item(1).Width = 2
		oCustomTable.Columns.Item(2).Width = 6
		oCustomTable.Columns.Item(3).Width = 2
		oCustomTable.Columns.Item(4).Width = .001
		oCustomTable.ShowTitle = True
		'oCustomTable.TableDirection = kBottomUpDirection
		'oCustomTable.HeadingPlacement = kHeadingAtBottom
		oCustomTable.WrapAutomatically = False
		'oCustomTable.MaximumRows=30
		oHeightCustomTable = oCustomTable.RangeBox.MaxPoint.Y - oCustomTable.RangeBox.MinPoint.Y
		oTablePt = ThisApplication.TransientGeometry.CreatePoint2d(.9525, oHeightCustomTable + .9525)
		oCustomTable.Position = oTablePt
	Else
		If oCustomTable.Rows.Count < oListComp.Count Then
			For i = oCustomTable.Rows.Count + 1 To oListComp.Count
				oCustomTable.Rows.Add()
			Next i
			oHeightCustomTable = oCustomTable.RangeBox.MaxPoint.Y - oCustomTable.RangeBox.MinPoint.Y
			oTablePt = ThisApplication.TransientGeometry.CreatePoint2d(.9525, oHeightCustomTable + .9525)
			oCustomTable.Position = oTablePt
		Else If oCustomTable.Rows.Count > oListComp.Count Then
		For i = oCustomTable.Rows.Count To oListComp.Count + 1 Step -1
			oCustomTable.Rows.Item(i).Delete()
		Next i
		oHeightCustomTable = oCustomTable.RangeBox.MaxPoint.Y - oCustomTable.RangeBox.MinPoint.Y
		oTablePt = ThisApplication.TransientGeometry.CreatePoint2d(.9525, oHeightCustomTable + .9525)
		oCustomTable.Position = oTablePt
	End If
	End If
	Dim iList As Long = 1
	For Each Item In oListComp
		oCustomTable.Rows.Item(iList).Item(1).Value = iList
		oCustomTable.Rows.Item(iList).Item(2).Value = Item.Key.Substring(0, Item.Key.IndexOf("X:\"))
		oCustomTable.Rows.Item(iList).Item(3).Value = Item.Value
		oCustomTable.Rows.Item(iList).Item(4).Value = Item.Key.Remove(0, Item.Key.IndexOf("X:\"))
		iList += 1
	Next
End Function

[kwarrenH4ZT3]

@Andrii_Humeniuk Thank you for the help I had to tweak the code at line 67 to below to get it to not include any files that were under the reference files. Also I'm running into an error on line 45 but this only happens on some assemblies do you know what this could be from?

	If oOcc.SubOccurrences IsNot Nothing Then
			'If oOcc.SubOccurrences.Count <> 0 Then Call GetListComponents(oOcc.SubOccurrences, oListComp)
			If oOcc.SubOccurrences.Count <> 0 Then 
				If oOcc.BOMStructure = BOMStructureEnum.kReferenceBOMStructure Or oOcc.Definition.BOMStructure = BOMStructureEnum.kReferenceBOMStructure Then
					Else
				Call GetListComponents(oOcc.SubOccurrences, oListComp)
			End If
		End If