Inventor Customization

Reply
Valued Contributor
dano0310
Posts: 91
Registered: ‎03-04-2007
Message 11 of 18 (778 Views)

Re: Inventor VBA xls export

11-07-2012 03:33 PM in reply to: varga_zsolt

Try This it should get you somewhere near where you need to be.

 

 

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
    
        With excel_app
            .Range("A1").Select
            .ActiveCell.Value = "Quantity"
            .Range("B1").Select
            .ActiveCell.Value = "Part Number"
        
            '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
                
                'Write values to spreadsheet
                .Range("A" & i + 1).Select
                .ActiveCell.Value = oBomR.TotalQuantity 'Quantity value
                .Range("B" & i + 1).Select
                .ActiveCell.Value = oBOMPartNo
            Next i
        End With
    Else
        Exit Sub
    End If

End Sub

 

Dont forget toset your reference to excel in the VBA.  Basically go to "Tools", "References" then look for "Microsoft Excel 14.0 Object Library".  Without it this wont work.

Active Contributor
varga_zsolt
Posts: 47
Registered: ‎09-15-2011
Message 12 of 18 (772 Views)

Re: Inventor VBA xls export

11-07-2012 11:14 PM in reply to: dano0310

Thank you dano0310, i try this code but there is error and i donn't konw what is the problem.

 

Active Contributor
varga_zsolt
Posts: 47
Registered: ‎09-15-2011
Message 13 of 18 (765 Views)

Re: Inventor VBA xls export

11-07-2012 11:55 PM in reply to: varga_zsolt
For precision i need this: i need the file like the csv attached, in the R column i need the date of the day whan i lunch the vba code :-D and i need to save the file in the folder where the *.iam is saved with the same name of the *.iam file but in *.csv separated by coma.
Active Contributor
varga_zsolt
Posts: 47
Registered: ‎09-15-2011
Message 14 of 18 (726 Views)

Re: Inventor VBA xls export

11-16-2012 05:24 AM in reply to: dano0310

Please can someone help me :smileysad:

ADN Support Specialist
adam.nagy
Posts: 521
Registered: ‎03-26-2007
Message 15 of 18 (702 Views)

Re: Inventor VBA xls export

11-21-2012 06:06 AM in reply to: varga_zsolt

Hi Zsolt,

 

Two things:

1) I cannot see the csv file you mention attached anywhere

2) The errer.jpg that is supposed to show the error you've run into does not actually show any error. It simply shows the line that VBA is about to execute, so it gives no clue about what problem you are running into

 

Also, it might be worth first just printing everything into the "Immediate" window of VBA to see what is going on.

E.g. :

Sub ListRows(brs As BOMRowsEnumerator)
    Dim br As BOMRow
    For Each br In brs
        Debug.Print br.ItemNumber & ", " & br.ItemQuantity
        
        If Not br.ChildRows Is Nothing Then
            Call ListRows(br.ChildRows)
        End If
    Next
End Sub

Sub test()
    Dim ad As AssemblyDocument
    Set ad = ThisApplication.ActiveDocument

    Dim acd As AssemblyComponentDefinition
    Set acd = ad.ComponentDefinition

    Dim bom As bom
    Set bom = acd.bom
    
    ' Depending on what you need
    bom.StructuredViewEnabled = True
    bom.StructuredViewFirstLevelOnly = False
    
    ' Structured BOM view is second if it's enabled
    Dim bv As BOMView
    Set bv = bom.BOMViews(2)
    
    ' Header
    Debug.Print "Item Number, Quantity"
    
    ' Data
    Call ListRows(bv.BOMRows)
End Sub

 

 

Cheers,



Adam Nagy
Developer Technical Services
Autodesk Developer Network
Active Contributor
varga_zsolt
Posts: 47
Registered: ‎09-15-2011
Message 16 of 18 (696 Views)

Re: Inventor VBA xls export

11-21-2012 06:29 AM in reply to: adam.nagy

1- Scuse me but i can't attach the *.csv file in this forum.

2 - The vba code give me the error you can see in the attached jpg.

Active Contributor
varga_zsolt
Posts: 47
Registered: ‎09-15-2011
Message 17 of 18 (678 Views)

Re: Inventor VBA xls export

11-26-2012 12:50 AM in reply to: dano0310

This is the line who gives me the error:

 

 

... 
For i = 1 To oAssyCompDef.BOM.BOMViews(3).BOMRows.Count
...
Active Contributor
varga_zsolt
Posts: 47
Registered: ‎09-15-2011
Message 18 of 18 (673 Views)

Re: Inventor VBA xls export

11-26-2012 06:23 AM in reply to: dano0310

I heve find a solution!! :smileytongue:

Sub BOM_Export()
    Dim oApp As Application
    Set oApp = ThisApplication
    Dim invDoc As Document
    Set invDoc = ThisApplication.ActiveDocument
    Dim oDocument As Inventor.Document
    Set oDocument = ThisApplication.ActiveDocument
    Dim invDesignInfo As PropertySet
    Set invDesignInfo = invDoc.PropertySets.Item("Design Tracking Properties")
    Dim invPartNumberProperty As Property
    Set invPartNumberProperty = invDesignInfo.Item("Part Number")
    NumeroParte = invPartNumberProperty.Value
    Estensione = (".csv")
    Patch = GetFilePatch(oDocument.FullFileName)
    PercaorsoNomeEst = (Patch & NumeroParte & Estensione)
    'Data
    Dim DataCmp As String
    DataCmp = (Day(Date) & "/" & Month(Date) & "/" & Year(Date))
       
    
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument
    Dim oBOM As BOM
    Set oBOM = oDoc.ComponentDefinition.BOM
    
     ' Imposta corrente il livello Principale
    Dim oAsmDef As AssemblyComponentDefinition
    Set oAsmDef = ThisApplication.ActiveDocument.ComponentDefinition
    oAsmDef.RepresentationsManager.LevelOfDetailRepresentations.Item("Principale").Activate

    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
        
        ' Setta la proprietà della vista strutturale al solo di primo livello
        oBOM.StructuredViewFirstLevelOnly = True
        
        ' Attiva la vista strutturata della distinata componenti
        oBOM.StructuredViewEnabled = True

        ' Crea l'applicazione Excel
        Set excel_app = CreateObject("Excel.Application")

        ' Commenta questa linea se vuoi excel invisibile
        excel_app.Visible = False
        
        'Crea il foglio di lavoro
        Call excel_app.Workbooks.Add
        Dim oBomR As BOMRow
        Dim oBOMPartNo As String
    
        With excel_app
            .Range("A1").Select
            .ActiveCell.Value = "Quantity"
            .Range("B1").Select
            .ActiveCell.Value = "Part Number"
            .Range("R1").Select
            .ActiveCell.Value = "Inizio Validità"
        
            'Iterate through parts only BOM View
            Dim i As Integer
            For i = 1 To oAssyCompDef.BOM.BOMViews(2).BOMRows.Count
                
                'Set oBomR to current BOM Row
                Set oBomR = oAssyCompDef.BOM.BOMViews(2).BOMRows(i)
                
                'Get Current Row part number from part
                oBOMPartNo = oBomR.ComponentDefinitions(1).Document.PropertySets(3).ItemByPropId(5).Value
                
                'Write values to spreadsheet
                .Range("A" & i + 1).Select
                .ActiveCell.Value = oBomR.TotalQuantity 'Quantity value
                .Range("B" & i + 1).Select
                .ActiveCell.Value = oBOMPartNo
                .Range("R" & i + 1).Select
                .ActiveCell.Value = DataCmp
            Next i
        End With
    Else
        Exit Sub
    End If
    ActiveWorkbook.SaveAs filename:=(PercaorsoNomeEst), FileFormat:=xlCSVWindows, CreateBackup:=False, Local:=True
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    End
End Sub

'Funzione che estrae il percorso completo nel quale si trova il file attualmente in uso
Private Function GetFilePatch(ByVal sFullFileName As String) As String

  Dim sFilePatch As String

  Dim nPos1  As Integer
  Dim nPosf1 As Integer
  Dim nPos2 As Integer
 
  sFilePatch = sFullFileName

  nPos1 = InStrRev(sFullFileName, "\")
  nPos2 = InStrRev(sFullFileName, ".")

  If nPos1 > 0 Then

    sFilePacth = Mid$(sFullFileName, nPos1 + 1)

  End If

  nPosf1 = InStr(sFullFileName, ".")

  If nPos1 > 0 Then

    sFilePatch = Left$(sFilePatch, nPosf1 - (nPos2 - nPos1))

  End If

  GetFilePatch = sFilePatch
  
End Function

 

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community


Inventor Exchange Apps

Created by the community for the community, Autodesk Exchange Apps for Autodesk Inventor helps you achieve greater speed, accuracy, and automation from concept to manufacturing.

Connect with Inventor

Twitter

Facebook

Blogs

Pinterest

Youtube