All Referenced Documents - individual document total count

[Anonymous]

I'm looking for a way to obtain a parts list from an assembly that will include all referenced assemblies/parts and their respective total quantities.

So for this structured BOM:

Item          Part Number          Qty

1                Assembly1              2

1.1             Assembly2              2

1.1.1          Part1                      1

1.1.2          Part2                      3

1.2             Part3                      4

The parts list would look like:

Part Number          Qty

Assembly1              2

Assembly2              4

Part1                      4

Part2                      12

Part3                      8

Any ideas on how to achieve?

[Owner2229 · Accepted solution]

Hey, try this:

Dim oDoc As Document = ThisApplication.ActiveDocument
If oDoc.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then Exit Sub
Dim oADO As Inventor.ComponentOccurrences = oDoc.ComponentDefinition.Occurrences
Dim ES As String = vbNullString
For Each aDoc As Document In oDoc.AllReferencedDocuments
	Dim sFN As String = aDoc.FullFileName
	Dim Amount As Integer = oADO.AllReferencedOccurrences(aDoc).Count
	Dim oPropsets As PropertySets = aDoc.PropertySets
	Dim oPropSet As PropertySet = oPropsets.Item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}")
	Dim PN As String = oPropSet("Part Number").Expression
	If ES <> vbNullString Then ES += vbNewLine
	ES += PN & " " & CStr(Amount)
Next
MsgBox(ES)

[Anonymous]

Works a treat! I just need to export to excel now and include a few more iProperties.

Thanks a million.

[mcloughlin_b]

HI Gents

Apologies for hijacking this topic but I have a very similar requirement and am wondering if this can be extended as follows:

• I need to export from an assembly to excel custom iProps of each assembly, sub-assembly and parts, such that each item is included only once
• Excel file will be written to a folder one level up from the assembly

Any assistance most appreciated.

Cheers

Bryan

[Owner2229]

Hey, I believe you should be able to sew it from this:

Custom property:

Dim oUserSet As PropertySet = oPropsets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
Dim sValue As String = oUserSet("iProName").Expression

Parent folder:

Dim oDoc As Document = ThisApplication.ActiveDocument
Dim sPath As String = oDoc.FullFileName
Dim FNP As Integer = InStrRev(sPath, "\", -1)
sPath = Left(sPath, FNP - 1)
FNP = InStrRev(sPath, "\", -1)
sPath = Left(sPath, FNP) ' add "-1" if you don't want the backslash included

[mcloughlin_b]

HI Mike

Thanks for that.

So I assume that will get me to the folder I want? And I'm sure I can read and get the properties, but how do you go about writing the props to excel, appending to the spreadsheet as the documents are parsed, or am I overthinking this (that's the normal case as I anticipate major coding required to achieve things, but am always amazed how simple and elegant you boffs make it seem).

Muchos Gracious

Bryan

[Owner2229]

Hey, as for the folder it'll give you e.g. the red part from:

C:\Users\Public\Documents\T_1000.ipt

As for the Excel writing, it would be something like this:

Dim oDoc As Document = ThisApplication.ActiveDocument
If oDoc.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then Exit Sub
Dim oADO As Inventor.ComponentOccurrences = oDoc.ComponentDefinition.Occurrences
GoExcel.Open("C:\Users\Public\Documents\excelfile.xlsx", "Sheet1")
Dim iRow As Integer = 2 'I guess you have a header on row 1, so let's start with row nr. 2
For Each aDoc As Document In oDoc.AllReferencedDocuments
	Dim sFN As String = aDoc.FullFileName
	Dim Amount As Integer = oADO.AllReferencedOccurrences(aDoc).Count
	Dim oPropsets As PropertySets = aDoc.PropertySets
	Dim oPropSet As PropertySet = oPropsets.Item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}")
	Dim oUserSet As PropertySet = oPropsets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
	Dim sPN As String = oPropSet("Part Number").Expression
	Dim sValue As String = oUserSet("iProName").Expression
	GoExcel.CellValue("A" & iRow) = sPN    'Write PartNumber to column A
	GoExcel.CellValue("B" & iRow) = Amount 'Write Amount to column B
	GoExcel.CellValue("C" & iRow) = sValue 'Write Custom iProperty to column C
	iRow += 1
Next
GoExcel.Save()
GoExcel.Close()

[mcloughlin_b]

Hi Mike

Thanks for that. I almost got this to work but have run into a few problems.

I am needing to run this every week so was hoping I could either start a new excel file based on a template (with predetermined headers) or open the existing and clear all entries before repopulating and renaming. I also want to append the current date to the end of the file ("assemblyname_dd-mm-yy.xlsx") but it seems like  Goexcel cannot create a new file from scratch and also does not have a saveas option (which would allow me to open a standard file and saveas with my date appended. Am I missing something or is there some super duper way of achieving this.

Many thanks,

Bryan

[Owner2229]

Hey, try this code below and then continue with GoExcel:

I'd only suggest you to use Japanese date format (YYYY-MM-DD) instead as it's then easier to sort.

Note: the "MM" in date formating has to be in capital letters, otherwise it'll add minutes from current time.

Dim sDate As String = Now().ToString("dd-MM-yyyy")
Dim oDoc As Document = ThisApplication.ActiveDocument
Dim sPath As String = oDoc.FullFileName
Dim FNP As Integer = InStrRev(sPath, "\", -1)
Dim FName As String = Mid(sPath, FNP + 1)
sPath = Left(sPath, FNP - 1)
FNP = InStrRev(sPath, "\", -1)
sPath = Left(sPath, FNP)
FNP = InStrRev(FName, ".", -1)
FName = Left(FName, FNP - 1) & "_" & sDate & ".xlsx"
sPath = sPath & FName

Dim oExcel As Object = CreateObject("Excel.Application")
oExcel.Visible = False
oExcel.DisplayAlerts = False
Dim oWorkbook As Object = oExcel.Workbooks.Add(Template: = "C:\Path\To\Template\File.xlsx")
oWorkbook.SaveAs(sPath)
oWorkbook.Close()
oExcel.Quit()
oExcel = Nothing

[mcloughlin_b]

HI Mike

Well, things are looking better but I am picking up errors along the way.

The code now creates a file from excel template and runs for a bit before crashing. I added some error trapping to try to find the dodgy bit but as you can see from the attached graphic, does not report the problem part filename but rather the top level assembly name. Not much help so I don't know what part is causing the failure. my code thus far is below, and all runs well until I start trying to read in custom iprops. Do you have any ideas or suggestions how to fix the error trap so it reports the part being processed and also what the problem might be?

SyntaxEditor Code Snippet

Dim sDate As String = Now().ToString("yyyy-MM-dd")
Dim oDoc As Document = ThisApplication.ActiveDocument
If oDoc.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then Exit Sub

Dim sPath As String = ThisDoc.Path & "\Excel\"
Dim tPath As String = ThisDoc.Path
Dim tName As String = "00-BULK_EXPORT.xlt"
Dim FName As String = ThisDoc.FileName(False) & "_" & sDate & ".xls"

sPath = sPath & FName
'MessageBox.Show("Export File is" & sPath, "Title")


Dim oExcel As Object = CreateObject("Excel.Application")
ErHa = "Start"
Try
    ErHa = "Create Export file from template"
        oExcel.Visible = False
        oExcel.DisplayAlerts = False
'        MessageBox.Show("template is" & tPath & "\" & tName, "Title")
    
        Dim oWorkbook As Object = oExcel.Workbooks.Add(Template: = tPath & "\" & tName)
    ErHa = "Save xls file"
        oWorkbook.SaveAs(sPath)
        oWorkbook.Close()
        oExcel.Quit()
        oExcel = Nothing

        Dim oADO As Inventor.ComponentOccurrences = oDoc.ComponentDefinition.Occurrences
    Erha = "Open xls File"
        GoExcel.Open(sPath, "Sheet1")
        Dim iRow As Integer = 2 'I guess you have a header on row 1, so let's start with row nr. 2
        For Each aDoc As Document In oDoc.AllReferencedDocuments
    ErHa = "Assign properties"
            Dim sFN As String = aDoc.FullFileName
            Dim Amount As Integer = oADO.AllReferencedOccurrences(aDoc).Count
            Dim oPropsets As PropertySets = aDoc.PropertySets
            Dim oPropSet As PropertySet = oPropsets.Item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}")
            Dim oUserSet As PropertySet = oPropsets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
            Dim sPN As String = oPropSet("Part Number").Expression
            Dim sSUBCAT As String = oUserSet("SUBCAT").Expression
'            Dim sPARTNO As String = oUserSet("PART NO").Expression'            Dim sDWGNO As String = oUserSet("DWGNO").Expression'            Dim sDWGREVNO As String = oUserSet("DWGREVNO").Expression'            Dim sDWGSTAT As String = oUserSet("DWGSTAT").Expression'            Dim sIVTYPE As String = oUserSet("IVTYPE").Expression'            Dim sDESCRIPTION As String = oPropSet("Description").Expression'            Dim sBOMPARTDESC As String = oUserSet("BOMPARTDESC").Expression'            Dim sS_L As String = oUserSet("S_L").Expression'            Dim sS_W As String = oUserSet("S_W").Expression'            Dim sS_H As String = oUserSet("S_H").Expression'            Dim sSYBIZ_PART_No As String = oUserSet("SYBIZ PART No").Expression'            Dim sSUPPLYNO As String = oUserSet("SUPPLYNO").Expression'            Dim sSUPPLYTYPE As String = oUserSet("SUPPLYTYPE").Expression'            Dim sPBLAST As String = oUserSet("PBLAST").Expression'            Dim sPPRIME As String = oUserSet("PPRIME").Expression'            Dim sPTOPCOAT As String = oUserSet("PTOPCOAT").Expression'            Dim sPMACHINE As String = oUserSet("PMACHINE").Expression'            Dim sPWELD As String = oUserSet("PWELD").Expression'            Dim sPINSTALL As String = oUserSet("PINSTALL").Expression'            Dim sPASSEMBLE As String = oUserSet("PASSEMBLE").Expression    
    ErHa = "Export properties"    
            GoExcel.CellValue("B" & iRow) = sPN    'Write PartNumber to column B
            GoExcel.CellValue("C" & iRow) = Amount 'Write Amount to column C
            GoExcel.CellValue("D" & iRow) = sSUBCAT 'Write Custom iProperty to column D'            GoExcel.CellValue("E" & iRow) = sPARTNO 'Write Custom iProperty to column E'            GoExcel.CellValue("F" & iRow) = sDWGNO 'Write Custom iProperty to column F'            GoExcel.CellValue("G" & iRow) = sDWGREVNO 'Write Custom iProperty to column G'            GoExcel.CellValue("H" & iRow) = sDWGSTAT 'Write Custom iProperty to column H'            GoExcel.CellValue("I" & iRow) = sIVTYPE 'Write Custom iProperty to column I'            GoExcel.CellValue("J" & iRow) = sDESCRIPTION 'Write Custom iProperty to column J'            GoExcel.CellValue("K" & iRow) = sBOMPARTDESC 'Write Custom iProperty to column K'            GoExcel.CellValue("L" & iRow) = sS_L 'Write Custom iProperty to column L'            GoExcel.CellValue("M" & iRow) = sS_W 'Write Custom iProperty to column M'            GoExcel.CellValue("N" & iRow) = sS_H 'Write Custom iProperty to column N'            GoExcel.CellValue("O" & iRow) = sSYBIZ_PART_No 'Write Custom iProperty to column O'            GoExcel.CellValue("P" & iRow) = sSUPPLYNO 'Write Custom iProperty to column P'            GoExcel.CellValue("Q" & iRow) = sSUPPLYTYPE 'Write Custom iProperty to column Q'            GoExcel.CellValue("R" & iRow) = sPBLAST 'Write Custom iProperty to column R'            GoExcel.CellValue("S" & iRow) = sPPRIME 'Write Custom iProperty to column S'            GoExcel.CellValue("T" & iRow) = sPTOPCOAT 'Write Custom iProperty to column T'            GoExcel.CellValue("U" & iRow) = sPMACHINE 'Write Custom iProperty to column U'            GoExcel.CellValue("V" & iRow) = sPWELD 'Write Custom iProperty to column V'            GoExcel.CellValue("W" & iRow) = sPINSTALL 'Write Custom iProperty to column W'            GoExcel.CellValue("X" & iRow) = sPASSEMBLE 'Write Custom iProperty to column X
        
        iRow += 1
    
Next
Catch ex As Exception
        MsgBox("Part: " & oDoc.DisplayName & vbLf & "Code-Part: " & ErHa & vbLf & "Error: " & ex.Message)
End Try
GoExcel.Save()
GoExcel.Close()

Many thanks

Bryan 

[Anonymous]

Change oDoc to aDoc to get the name of the document that's giving you the issue.

My guess would be that the error is caused by a missing parameter in one of the documents.

MsgBox("Part: " & aDoc.DisplayName & vbLf & "Code-Part: " & ErHa & vbLf & "Error: " & ex.Message)

[mcloughlin_b]

Hi Craig

Thanks.

I have tried this but get the following message

Not sure why as it seems to me like aDoc is declared.

Also, any idea how I can check for missing parameters first. I'm thinking i'd need to do a try catch on the iprops first. Does that sound feasible?

Thanks and cheers,

Bryan

[Anonymous]

Hi @mcloughlin_b

Sorry for taking so long to get back to you, not had much time on the forums recently with work being so busy.

If you haven't already moved on from this issue, i think it's because you need to declare variables outside of a try catch block

Dim aDoc As Document

Try

For Each aDoc In oDoc.AllReferencedDocuments
Next

Catch ex As Exception

End Try

[andrew.tom.reynolds]

Hi Mike,

I've just used this solution for a slightly different application where I write the count value to an iProperty field for each part and it works great, picking up the correct count for all active occurrences of each part.

Only thing is, I want to write a "0" value out to the same iProperty for any items that don't occur at all (where all instances are suppressed). I was thinking that the easiest way would be to first write "0" into the iProperty value for all parts within the entire assembly and then run the count function and update the value to the correct count for those items which do occur.

Can you help me out with the correct code to be able to address all parts whether or not they are suppressed?

Cheers,

Andrew.