Well I had some time to relook at this thread. Below is the code to do what you are looking for. I took the code from the "QTY BOM" thread that I mentioned and tweaked it to get the parent folder name instead of the quantity. Hope this helps. BTW, this will skip library parts, read only files and CC files.
Sub Main
'Get current document
doc = ThisDoc.Document
Dim oAssyDef As AssemblyComponentDefinition = doc.ComponentDefinition
'Get the BOM object
Dim oBOM As BOM = oAssyDef.BOM
'enable the Parts Only View
oBOM.PartsOnlyViewEnabled = True
'Get the Parts Only view of the BOM
Dim oBOMViewPO As BOMView = oBOM.BOMViews.Item("Parts Only")
'declare variable for each BOM row.
Dim oBOMRowPO As BOMRow
'For each row in the Parts Only BOM, do the following
For Each oBOMRowPO In oBOMViewPO.BOMRows
'Set a reference to the primary ComponentDefinition of the row
Dim oCompDef As ComponentDefinition = oBOMRowPO.ComponentDefinitions.Item(1)
'get the full filename associated to the component in the row. ex: c:\temp\part1.ipt
Dim CompFullDocumentName As String = oCompDef.Document.FullDocumentName
Dim CompFileNameOnly As String
'get the location of the last backslash
Dim index As Integer = CompFullDocumentName.lastindexof("\")
'get the filename only from the full filename
CompFileNameOnly = CompFullDocumentName.substring(index+1)
Dim FilePath As String = CompFullDocumentName.substring(0,CompFullDocumentName.Length - CompFileNameOnly.length-1)
Dim ParentFolder As String
Dim FolderIndex As Integer = FilePath.lastindexof("\")
ParentFolder = FilePath.substring(FolderIndex+1)
'MessageBox.Show(CompFileNameOnly & vbCr & ParentFolder)
'check to see if the component is a library part, cc part or read only.
Dim IsLibCCReadonly As Boolean = LibCCReadonlyChecker(CompFullDocumentName)
'if the file is NOT a library part, cc part or read only.
If IsLibCCReadonly = False Then
'set following custom iproperty to equal the QTY from the row
iProperties.Value(CompFileNameOnly, "Custom", "Folder") = ParentFolder
End If
Next
'at this time, the qty value for all parts have been copied to the custom property.
'next, the following code will cycle through only the subassemblies.
'if the Structured BOM view is enabled then...
If oBOM.StructuredViewEnabled Then
'If show First Level is set then turn it off. This will set it to All Levels
If oBOM.StructuredViewFirstLevelOnly Then
oBOM.StructuredViewFirstLevelOnly = False
End If
Else
'enable the Structured BOM view
oBOM.StructuredViewEnabled = True
'set the FirstLevelOnly to false therefore make it All Levels
oBOM.StructuredViewFirstLevelOnly = False
End If
'Get the Structured view of the BOM
Dim oBOMViewStruc As BOMView = oBOM.BOMViews.Item("Structured")
'declare variable for each BOM row.
Dim oBOMRowStruc As BOMRow
'Create a blank array(list). This will be used to store a list of all subassemblies for comparing if the subassembly already exist.
Dim arrSubAssemblyList As New ArrayList
'call a subroutine to cycle through the structured BOM. It will need the collection of rows, the subassembly list, and 1 is the initial parentqty.
Call QueryBOMRowProperties(oBOMViewStruc.BOMRows, arrSubAssemblyList)
End Sub
Private Sub QueryBOMRowProperties(oBOMRows As BOMRowsEnumerator, arrSubAssembly As ArrayList)
'declare a incrementer variable
Dim i As Long
'for each row in the structured BOM
For i = 1 To oBOMRows.count
'get the row based on the incrementer
Dim oBOMRowStruc As BOMRow = oBOMRows.item(i)
'get the component definition assocated with the row
Dim oCompDef As ComponentDefinition = oBOMRowStruc.ComponentDefinitions.item(1)
Dim oQty As Integer
'If the component is an assembly and it's bom structure is Normal then do the following. else do nothing
If TypeOf oCompDef Is AssemblyComponentDefinition And oCompDef.BOMStructure = BOMStructureEnum.kNormalBOMStructure Then
'get the full filename associated to the component in the row. ex: c:\temp\subassembly.iam
Dim CompFullDocumentName As String = oCompDef.Document.FullDocumentName
Dim CompFileNameOnly As String
'get the location of the last backslash
Dim index As Integer = CompFullDocumentName.lastindexof("\")
'get the filename only from the full filename
CompFileNameOnly = CompFullDocumentName.substring(index+1)
'MessageBox.Show(CompFileNameOnly)
Dim FilePath As String = CompFullDocumentName.substring(0,CompFullDocumentName.Length - CompFileNameOnly.length-1)
Dim ParentFolder As String
Dim FolderIndex As Integer = FilePath.lastindexof("\")
ParentFolder = FilePath.substring(FolderIndex+1)
'check to see if the component is a library part, cc part or read only.
Dim IsLibCCReadonly As Boolean = LibCCReadonlyChecker(CompFullDocumentName)
'if the file is NOT a library part, cc part or read only.
If IsLibCCReadonly = False Then
'set following custom iproperty to equal the QTY from the row plus the additional qty value
iProperties.Value(CompFileNameOnly, "Custom", "Folder") = ParentFolder
'Recursively iterate child rows if present.
If Not oBOMRowStruc.ChildRows Is Nothing Then
'recall the subroutine, push the childrows of the sub, sub assembly array (list)
Call QueryBOMRowProperties(oBOMRowStruc.ChildRows, arrSubAssembly)
End If
End If
End If
Next
End Sub
Private Function LibCCReadonlyChecker(filename As String) As Boolean
' Get the active project
Dim oProject As DesignProject = ThisApplication.DesignProjectManager.ActiveDesignProject
' Get all the library paths
Dim oLibraryPaths As ProjectPaths = oProject.LibraryPaths
Dim oLibraryPath As ProjectPath
'for each library path in the list of all library paths
For Each oLibraryPath In oLibraryPaths
'get the library path
Dim oLibs As String = oLibraryPath.Path
'if the file is in a library path then Return True
If filename.Contains(oLibs) = True Then
Return True
End If
Next
'if the file is in the CC location then Return True
If filename.Contains(oProject.ContentCenterPath) = True Then
Return True
End If
'get read only status
Dim File_Attr As Long = System.IO.File.GetAttributes(filename)
'if the file is readonly or readonly and archieve then Return True
If File_Attr = 1 Or File_Attr = 33 Then
Return True
End If
'return the current value for the boolean variable
Return False
End Function
