BOMRow.ComponentDefinitions(1).ReferenceComponents.DerivedPartComponents

[shastu]

I need to export out all the part(s) that go into a derived part into an excel spreadsheet.  I already am exporting what I need from the BOM and putting it into an excel spreadsheet but it doesn't catch anything below a derived part.  If it is derived from a part, I would just need the part, but if it is a derived assembly, I need the entire structure of the assembly.  Someone suggested using this:

BOMRow.ComponentDefinitions(1).ReferenceComponents.DerivedPartComponents

I don't know enough yet to understand how I can use this to accomplish what I need, can someone help?

Thanks,

This is what I have so far:

Sub BOM_Export()
    Dim oApp As Application
    Set oApp = ThisApplication

    If oApp.ActiveDocument.DocumentType = kAssemblyDocumentObject Then
        Dim oAssyDoc As AssemblyDocument
        Set oAssyDoc = oApp.ActiveDocument
   
        Dim oAssyCompDef As AssemblyComponentDefinition
        Set oAssyCompDef = oAssyDoc.ComponentDefinition
   
        'Dim excel_app As Excel.Application

        ' Create the Excel application.
        Set excel_app = CreateObject("Excel.Application")

        ' Uncomment this line to make Excel visible.
        excel_app.Visible = True
   
        'Create new workbook
        Call excel_app.Workbooks.Add
   
        Dim oBomR As BOMRow
        Dim oBOMPartNo As String
        Dim oBomComments As String
       
Dim odoc As Document
Set odoc = ThisApplication.ActiveDocument
Dim oPropSet As PropertySet
Set oPropSet = ThisApplication.ActiveDocument.PropertySets("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}")
Dim oProp As Property
Set oProp = oPropSet.Item("Comments")

    Dim sProp As String
         sProp = Right(odoc.FullFileName, Len(odoc.FullFileName) - InStrRev(odoc.FullFileName, "\"))
        ' This strips off the last 4 digits of the filename.
        sProp = Left(sProp, Len(sProp) - 4)
 
        With excel_app
            .Range("A:A").ColumnWidth = 20
            .Range("B:B").ColumnWidth = 20
            .Range("A1").Select
            .ActiveCell.Value = "Part Number"
            .Range("B1").Select
            .ActiveCell.Value = "Copied From"
            .Range("A2").Select
            .ActiveCell.Value = sProp
            .Range("B2").Select
            .ActiveCell.Value = oProp.Value
   
    Dim ad As AssemblyDocument
    Set ad = ThisApplication.ActiveDocument

    Dim acd As AssemblyComponentDefinition
    Set acd = ad.ComponentDefinition

    Dim bom As bom
    Set bom = acd.bom
   
    ' Enable both Structured View and PartOnlyView
    bom.StructuredViewEnabled = True
    bom.StructuredViewFirstLevelOnly = False
    bom.PartsOnlyViewEnabled = True
           
            'Iterate through parts only BOM View
            Dim i As Integer
           
            For i = 1 To oAssyCompDef.bom.BOMViews(3).BOMRows.Count
               
                'Set oBomR to current BOM Row
                Set oBomR = oAssyCompDef.bom.BOMViews(3).BOMRows(i)
               
                'Get Current Row part number from part
                oBOMPartNo = oBomR.ComponentDefinitions(1).Document.PropertySets(3).ItemByPropId(5).Value

                'Get Current comments from BOM
                oBomComments = oBomR.ComponentDefinitions(1).Document.PropertySets.Item("Summary Information").Item("Comments").Value
   
              
               
                'Write values to spreadsheet
                i = i + 1
                .Range("A" & i + 1).Select
                .ActiveCell.Value = oBOMPartNo
                .Range("B" & i + 1).Select
                .ActiveCell.Value = oBomComments
                i = i - 1
               
           Next i
          
        excel_app.ActiveWorkbook.Saveas FileName:="C:\Users\ShaStu\Documents\" & sProp & ".xlsx"
       
       
           
        excel_app.Workbooks.Close
        excel_app.Quit
       
       

        End With
    End If
End Sub

[adam.nagy]

Hi,

Yes, through that property you should be able to find out which file (in this case assembly) the part was derived from.

Then you can just read all the components of the assembly.

Cheers,

[MechMachineMan]

Since it's Christmas season... I rehashed all of your code to something that's workable. Take care to notice how the progression of declarations of variables work, and PLEASE read up on what assigning a value to an object is.

In your old code that I reworked, you had several lines assigning the same object to different variables, just using different wording each time.

Also noticed how I split it up into multiple subs. When creating a new object this is often good practice so that the code is cleaner and errors can be handled easier to ensure the created objects are properly released from memory.

You will notice if/when you tweak this that if the excel_app object isn't run during a debug run, it will leave an EXCEL.exe active in the task manager that will have to be force-closed by ending the process via task manager.

Did some debugging on it as well, so it should definitely be working.

'Ensure this macro has Microsoft excel added as a reference

'Putting this up here outside of both subs allows us to use it globally.
Dim xlws As Excel.WorkSheet

Sub BOM_Export()

 Dim oApp As Inventor.Application
 Set oApp = ThisApplication

 If oApp.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
 Call MsgBox("Active File is not Assembly. Aborting Rule")
 End If
 
 Dim excel_app As Excel.Application
 Set excel_app = CreateObject("Excel.Application")
 excel_app.Visible = True
 
 Dim xlwb As Excel.WorkBook
 Set xlwb = excel_app.Workbooks.Add
 
 Set xlws = xlwb.Worksheets(1)

 xlws.Range("A:A").ColumnWidth = 20
 xlws.Range("B:B").ColumnWidth = 20
 xlws.Range("A1").Value = "Part Number"
 xlws.Range("B1").Value = "Copied From"

 Dim oDoc As AssemblyDocument
 Set oDoc = oApp.ActiveDocument
 
 Call ProcessPartsOnlyBOM(oDoc)
 
 sProp = oDoc.PropertySets(3).ItemByPropId(5).Value
 xlwb.SaveAs FileName:="C:\Users\ShaStu\Documents\" & sProp & ".xlsx"
 xlwb.Close

 excel_app.Quit

 Set xlwb = Nothing
 Set xlws = Nothing
 Set excel_app = Nothing

 MsgBox ("Rule Complete!")
End Sub

'By making this private, it won't appear to click as a macro, which we want since it would error out since it doesn't generate it's own instance of xlws
Private Sub ProcessPartsOnlyBOM(oDoc As Document)

 Dim oBOM As BOM
 Set oBOM = oDoc.ComponentDefinition.BOM

' oBOM.StructuredViewEnabled = True
' oBOM.StructuredViewFirstLevelOnly = False
 oBOM.PartsOnlyViewEnabled = True

 Dim oPartsOnlyBOM As BOMView
 Set oPartsOnlyBOM = oBOM.BOMViews.Item("Parts Only")
 
 Dim oBOMRow As BOMRow

 ' j will be our counter to track which row in excel we are writing to.
 Dim j As Integer
 j = 2

 For i = 1 To oPartsOnlyBOM.BOMRows.Count
 Set oBOMRow = oPartsOnlyBOM.BOMRows(i)
 
 'This row causes the rule to skip every BOMRow that isn't for a part file.
 If oBOMRow.ComponentDefinitions(1).Type <> 83886592 Then 'ObjectTypeEnum.kPartComponentDefinition
 xlws.Cells(j, 1).Value = "SKIPPED BOM ROW"
 j = j + 1
 GoTo SkipRow
 End If
 
 Set oBOMRowDoc = oBOMRow.ComponentDefinitions(1).Document
 xlws.Cells(j, 1).Value = "Hi"
 xlws.Cells(j, 1).Value = oBOMRowDoc.PropertySets("Design Tracking Properties")("Part Number").Value
 xlws.Cells(j, 2).Value = oBOMRowDoc.PropertySets.Item("Summary Information").Item("Comments").Value
 j = j + 1

 If oBOMRow.ComponentDefinitions(1).ReferenceComponents.DerivedPartComponents.Count > 0 Then
 For Each oDerivedpartComponent In oBOMRow.ComponentDefinitions(1).ReferenceComponents.DerivedPartComponents
 xlws.Cells(j, 1).Value = "DERIVED PART"
 xlws.Cells(j, 2).Value = oDerivedpartComponent.ReferencedDocumentDescriptor.FullDocumentName()
 j = j + 1
 Next
 End If

SkipRow:
 If Err.Number <> 0 Then
 Call MsgBox("Issues accessing BOM row document! May be a virtual part row. Need extra coding to handle these")
 Err.Clear
 End If
 Next
End Sub

[Owner2229]

You're missing the exiting part of the document check.

If oApp.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
   Call MsgBox("Active File is not Assembly. Aborting Rule")
   Exit Sub
End If

 Also globals sould be defined as one of these (it depends on if you want to acces them from other modules/classes):

Private xlws As Excel.WorkSheet

Public xlws As Excel.WorkSheet

[MechMachineMan]

Good catch!

Guess I should probably quit coding up until midnight and give my brain a rest.

Repaired code:

'Ensure this macro has Microsoft excel added as a reference

'Putting this up here outside of both subs allows us to use it globally.
Private xlws As Excel.WorkSheet

Sub BOM_Export()

 Dim oApp As Inventor.Application
 Set oApp = ThisApplication

 If oApp.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
       Call MsgBox("Active File is not Assembly. Aborting Rule")
       Exit Sub
 End If
 
 Dim excel_app As Excel.Application
 Set excel_app = CreateObject("Excel.Application")
 excel_app.Visible = True
 
 Dim xlwb As Excel.WorkBook
 Set xlwb = excel_app.Workbooks.Add
 
 Set xlws = xlwb.Worksheets(1)

 xlws.Range("A:A").ColumnWidth = 20
 xlws.Range("B:B").ColumnWidth = 20
 xlws.Range("A1").Value = "Part Number"
 xlws.Range("B1").Value = "Copied From"

 Dim oDoc As AssemblyDocument
 Set oDoc = oApp.ActiveDocument
 
 Call ProcessPartsOnlyBOM(oDoc)
 
 sProp = oDoc.PropertySets(3).ItemByPropId(5).Value
 xlwb.SaveAs FileName:="C:\Users\ShaStu\Documents\" & sProp & ".xlsx"
 xlwb.Close

 excel_app.Quit

 Set xlwb = Nothing
 Set xlws = Nothing
 Set excel_app = Nothing

 MsgBox ("Rule Complete!")
End Sub

'By making this private, it won't appear to click as a macro, which we want since it would error out since it doesn't generate it's own instance of xlws
Private Sub ProcessPartsOnlyBOM(oDoc As Document)

 Dim oBOM As BOM
 Set oBOM = oDoc.ComponentDefinition.BOM

' oBOM.StructuredViewEnabled = True
' oBOM.StructuredViewFirstLevelOnly = False
 oBOM.PartsOnlyViewEnabled = True

 Dim oPartsOnlyBOM As BOMView
 Set oPartsOnlyBOM = oBOM.BOMViews.Item("Parts Only")
 
 Dim oBOMRow As BOMRow

 ' j will be our counter to track which row in excel we are writing to.
 Dim j As Integer
 j = 2

 For i = 1 To oPartsOnlyBOM.BOMRows.Count
 Set oBOMRow = oPartsOnlyBOM.BOMRows(i)
 
 'This row causes the rule to skip every BOMRow that isn't for a part file.
 If oBOMRow.ComponentDefinitions(1).Type <> 83886592 Then 'ObjectTypeEnum.kPartComponentDefinition
 xlws.Cells(j, 1).Value = "SKIPPED BOM ROW"
 j = j + 1
 GoTo SkipRow
 End If
 
 Set oBOMRowDoc = oBOMRow.ComponentDefinitions(1).Document
 xlws.Cells(j, 1).Value = "Hi"
 xlws.Cells(j, 1).Value = oBOMRowDoc.PropertySets("Design Tracking Properties")("Part Number").Value
 xlws.Cells(j, 2).Value = oBOMRowDoc.PropertySets.Item("Summary Information").Item("Comments").Value
 j = j + 1

 If oBOMRow.ComponentDefinitions(1).ReferenceComponents.DerivedPartComponents.Count > 0 Then
 For Each oDerivedpartComponent In oBOMRow.ComponentDefinitions(1).ReferenceComponents.DerivedPartComponents
 xlws.Cells(j, 1).Value = "DERIVED PART"
 xlws.Cells(j, 2).Value = oDerivedpartComponent.ReferencedDocumentDescriptor.FullDocumentName()
 j = j + 1
 Next
 End If

SkipRow:
 If Err.Number <> 0 Then
 Call MsgBox("Issues accessing BOM row document! May be a virtual part row. Need extra coding to handle these")
 Err.Clear
 End If
 Next
End Sub