Getting Virtual Components to be counted/included in an EXCEL BOM

[brendan.henderson]

Hi all.

I'm after some help in geting virtual Components to be included in an Excel output of an assy BOM. I have an existing macro (see code below) that exports the StockNumber, partNumber,Description and an occurrence count of each item to an Excel spreadshet. It all works fine except for Virtual Componenst which are not included. It seems that because no file is created that the VC item can't be included in the Excel doc. Can anybody shed some light on getting VC items included in the output?

Sub Assy2Excel()

Dim oAssDoc As AssemblyDocument
Set oAssDoc = ThisApplication.ActiveDocument

Dim SIPropSet As PropertySet
Set SIPropSet = oAssDoc.PropertySets.Item("Summary Information")
Dim rev As String
rev = SIPropSet.ItemByPropId(kRevisionSummaryInformation).Value

If oAssDoc.DocumentType <> kAssemblyDocumentObject Then
    MsgBox "The Active document must be an 'Assembly'.", vbExclamation
    Exit Sub
End If

If MsgBox("The generated list is for the use of the Purchasing Department. It counts all of the BOUGHT & MADE parts in the assembly. Some manual editing will be required to 'clean up' the list. Do you want to continue?", vbYesNo + vbQuestion) = vbNo Then
        Exit Sub
    End If

Dim oDocs As DocumentsEnumerator
Set oDocs = oAssDoc.AllReferencedDocuments

Dim oDoc As Document

Dim row As Integer
Dim excel_app As Excel.Application

app2check = "Excel.Application"
If IsApplicationRunning(app2check) = True Then
    Set excel_app = Excel.Application
Else
    Set excel_app = CreateObject("Excel.Application")
End If

excel_app.Visible = True
excel_app.Workbooks.Add

With excel_app
    .Columns("A:A").ColumnWidth = 13
    .Range("A1").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Calibri"
        .Size = 14
    End With
    .ActiveCell.FormulaR1C1 = "ASSEMBLY PARTS LIST-INCLUDES BOUGHT & MADE PARTS (Part QTY shown is for 1 of the Assembly No. shown below)"
    
    '.Columns("A:A").ColumnWidth = 13
    .Range("A2").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Color = -6279056
        .TintAndShade = 0
    End With
    .ActiveCell.FormulaR1C1 = "If the Assembly No. below does not end in -00000 then the QTY's shown may be wrong as this list has been generated from a sub-assembly!"
    
    '.Columns("A:A").ColumnWidth = 13
    .Range("A3").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    .ActiveCell.FormulaR1C1 = "This list shows BOUGHT and MADE items but excludes quantities for Sheet Metal and Plasma parts  (i.e. sheet and plate). CHECK THIS LIST AGAINST DRAWINGS BEFORE ORDERING PARTS/MATERIALS!"
    
    .Range("A5").Select
    Selection.Font.Bold = True
    .ActiveCell.FormulaR1C1 = "ASSEMBLY No. - " & Left(oAssDoc.DisplayName, Len(oAssDoc.DisplayName) - 4)
    
    .Range("H4").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlRight
    End With
    .ActiveCell.FormulaR1C1 = "REVISION - " & rev
    
    .Range("A6").Select
    Selection.Font.Bold = True
    .ActiveCell.FormulaR1C1 = "Stock Code"

    .Columns("B:B").ColumnWidth = 13
    .Range("B6").Select
    Selection.Font.Bold = True
    .ActiveCell.FormulaR1C1 = "Part Code"
    
    .Columns("C:C").ColumnWidth = 6
    .Range("C6").Select
    Selection.Font.Bold = True
    .ActiveCell.FormulaR1C1 = "Qty"

    .Columns("D:D").ColumnWidth = 105
    .Range("D6").Select
    Selection.Font.Bold = True
    .ActiveCell.FormulaR1C1 = "Description"
    
    .Columns("E:E").ColumnWidth = 15
    .Range("E6").Select
    Selection.Font.Bold = True
    .ActiveCell.FormulaR1C1 = "Supplier"
    
    .Columns("F:F").ColumnWidth = 15
    .Range("F6").Select
    Selection.Font.Bold = True
    .ActiveCell.FormulaR1C1 = "P.O. Number"
    
    .Columns("G:G").ColumnWidth = 15
    .Range("G6").Select
    Selection.Font.Bold = True
    .ActiveCell.FormulaR1C1 = "Date Ordered"
    
    .Columns("H:H").ColumnWidth = 10
    .Range("H6").Select
    Selection.Font.Bold = True
    .ActiveCell.FormulaR1C1 = "Initials"
        
    .Columns("H:H").ColumnWidth = 15
    .Range("H1").Select
    .ActiveCell.FormulaR1C1 = Date
    
    .Columns("H:H").ColumnWidth = 15
    .Range("H2").Select
    .ActiveCell.FormulaR1C1 = Time

row = 6

For Each oDoc In oDocs

    Dim oOccs As ComponentOccurrencesEnumerator
    Set oOccs = oAssDoc.ComponentDefinition.Occurrences.AllReferencedOccurrences(oDoc)

    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets

    Dim oProp1 As Property
    Set oProp1 = oPropSets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}").ItemByPropId(kStockNumberDesignTrackingProperties)
    oStockNumber = oProp1.Value
    
    Dim oProp2 As Property
    Set oProp2 = oPropSets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}").ItemByPropId(kPartNumberDesignTrackingProperties)
    oPartNumber = oProp2.Value
    
    Dim oProp3 As Property
    Set oProp3 = oPropSets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}").ItemByPropId(kDescriptionDesignTrackingProperties)
    oDescription = oProp3.Value
                   
        If oOccs.Count <> 0 Then
            row = row + 1
            With excel_app
                .Range("A" & Format$(row)).Select
                .ActiveCell.FormulaR1C1 = oStockNumber
                .Range("B" & Format$(row)).Select
                .ActiveCell.FormulaR1C1 = oPartNumber
                .Range("C" & Format$(row)).Select
                .ActiveCell.FormulaR1C1 = oOccs.Count
                .Range("D" & Format$(row)).Select
                .ActiveCell.FormulaR1C1 = oDescription
            End With
        End If
Next

[brendan.henderson]

bump

[brendan.henderson]

I'm surprised no oNe has any idea? So I'm trying again. Below is the engine part of the code :-

row = 7

For Each oDoc In oDocs

    Dim oOccs As ComponentOccurrencesEnumerator
    Set oOccs = oAssDoc.ComponentDefinition.Occurrences.AllReferencedOccurrences(oDoc)

    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets

    Dim oProp1 As Property
    Set oProp1 = oPropSets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}").ItemByPropId(kStockNumberDesignTrackingProperties)
    oStockNumber = oProp1.Value
    
    Dim oProp2 As Property
    Set oProp2 = oPropSets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}").ItemByPropId(kPartNumberDesignTrackingProperties)
    oPartNumber = oProp2.Value
    
    Dim oProp3 As Property
    Set oProp3 = oPropSets.Item("{32853F0F-3444-11d1-9E93-0060B03C1CA6}").ItemByPropId(kDescriptionDesignTrackingProperties)
    oDescription = oProp3.Value
    
           
        If oOccs.Count <> 0 Then
            row = row + 1
            With excel_app
                .Range("A" & Format$(row)).Select
                .ActiveCell.FormulaR1C1 = oStockNumber
                .Range("B" & Format$(row)).Select
                .ActiveCell.FormulaR1C1 = oPartNumber
                .Range("C" & Format$(row)).Select
                .ActiveCell.FormulaR1C1 = oOccs.Count
                .Range("D" & Format$(row)).Select
                .ActiveCell.FormulaR1C1 = oDescription
            End With
        End If
Next

And I'm thinking of adding something like this, supplied by Brian Ekins in this post http://forums.autodesk.com/t5/Autodesk-Inventor-Customization/How-to-get-a-parts-list/td-p/3460308

BOMRow oRow = oStructuredBOMView.BOMRows[i];
	ComponentDefinition oCompDef = oRow.ComponentDefinitions[1];
	Property oPartName;
	if ((oCompDef.GetType () is VirtualComponentDefinition))
	{
		oPartName = oCompDef.PropertySets.Item["Design Tracking Properties"].Item["Part Number"];
	}
	else
	{
		oPartName = oCompDef.Document.PropertySets.Item["Design Tracking Properties"].Item["Part Number"];
	}

But I don't know how too! I've had a few goes and keep coming up blank. Probaly doesn't thelp that I'm not trained in any of this. So please if anybody can shed some light it will be greatly appreciated.