Thema "Betreff: Inventor Stückliste Stückzahl der Baugruppen" in Inventor - Deutsches Forum

Inventor Stückliste Stückzahl der Baugruppen

Anonymous — Wed, 10 Jan 2018 13:49:53 GMT

Guten Tag Community,

ich brauche Hilfe.

Ich habe Inventor 2017 und habe eine Baugruppe! Diese Baugruppe hat Unterbaugruppen und die Unterbaugruppe hat auch Unterbaugruppen. (Siehe Bild)

Jetzt meine Frage:

Ich möchte jetzt wissen wie oft ich Baugruppe "test1" fertigen muss! Deswegen brauche ich die gesamte Stückzahl aus der Baugruppe "test2". Also wie oft "test1" in "test2" drinne steckt.

Jetzt steht da eine "2" bei "test1" also 2 mal gibt es die Baugruppe "test1" in der Baugruppe "test". Da ich "test" 2 mal in "test2" habe, habe ich "test1" insgesamt 8 mal in "test2"!

Könntet ihr mir bitte ein Makro schreiben, wo er eine Excel Tabelle erstellt und alle Baugruppen (NUR Baugruppen) der geöffneten Baugruppe auflistet (Spalte A) und daneben die Stückzahl der jeweiligen Baugruppen hinschreibt (Spalte B). Die Stückzahl nimmt das Makro aus der geöffneten Baugruppe raus. Ist es möglich?

Ich bin gerade bzw immer noch am lernen die Sprache zu verstehen. Kriege aber sowas leider noch nicht hin.

Ich danke im vorraus!!

Mfg,

Ptach

Betreff: Inventor Stückliste Stückzahl der Baugruppen

Juergen_Wagner — Wed, 10 Jan 2018 19:08:26 GMT

Mach das in der Zeichnung mit der Teileliste

So sieht meine IAM aus

Die Rohrleitung ist 6x in der Struktur verbaut.

Hier die Teileleiste in der Zeichnung. Summe Rohrleitungen über die Gruppierenfunktion der Teileliste

Alternativen:

Export in XLS und dort über ein Makro (wie immer das auch aussieht) summieren
über ein Inventor Makro das Vorkommen jeder Komponenten die nicht Phantom oder Referenz ist zählen.

Betreff: Inventor Stückliste Stückzahl der Baugruppen

Anonymous — Wed, 10 Jan 2018 20:00:59 GMT

Hallo @Juergen_Wagner,

das klappt fast.

bei mir zeigt er die Einzelteile an, die Baugruppen blendet er aus. Wieso?

Betreff: Inventor Stückliste Stückzahl der Baugruppen

Juergen_Wagner — Wed, 10 Jan 2018 20:22:34 GMT

Mach ein Pack&Go von Zeichnung inkl. der IAM und aller zugehörigen Dateien und lade sie als ZIP hoch dann schaue ich. Sonst ist das für mich nur fischen im Trüben.

Betreff: Inventor Stückliste Stückzahl der Baugruppen

Anonymous — Thu, 11 Jan 2018 06:25:44 GMT

Hallo,

es geht ja eigentlich nur darum das Inventor die Baugruppe anzeigen soll und nicht die Einzelteile.

Ich habe nur Test-Dateien erstellt.

Mit freundlichen Grüßen,

Ptach

Betreff: Inventor Stückliste Stückzahl der Baugruppen

Juergen_Wagner — Thu, 11 Jan 2018 07:24:33 GMT

Ja genau, und diese Testdaten brauche ich um zu sehen, was los ist.

Betreff: Inventor Stückliste Stückzahl der Baugruppen

Anonymous — Thu, 11 Jan 2018 08:27:12 GMT

Alles klar 🙂

Hab das als ZIP Datei zusammen gepackt.

In die iProperties habe ich irgendwas rein geschrieben, also nicht beachten 😄

Ich danke im voraus für die Erklärung!

Betreff: Inventor Stückliste Stückzahl der Baugruppen

Juergen_Wagner — Thu, 11 Jan 2018 15:34:15 GMT

Ich bekomme es mit deiner IAM auch nicht hin.

Wenn die Haupt-IAM (test2) und Unter-IAM(test) nicht stücklistenrelevant sind, dann setze sie auf Phantom (In der IAM Stückliste), dann wird dir die Summe der Montagebaugruppe angezeigt. (auch ohne Gruppierung)

Betreff: Inventor Stückliste Stückzahl der Baugruppen

Juergen_Wagner — Thu, 11 Jan 2018 15:57:20 GMT

Das VBA-Makro sollte das Problem lösen. Leicht angepasst von mir. Quelle siehe Link (Anleitung Makro einrichten)

'Quelle https://forums.autodesk.com/t5/inventor-customization/vba-counting-quantity-of-parts-in-assemblies/td-p/5666311
'Leicht angepasst von JW
Public Sub bomexport()
'Dim myFile As String
''Pfad zu XLS-Vorlagendateien
'myFile = "c:\_temp_permanent\test.xlsx"
        
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveEditDocument
    
    ' Set a reference to the BOM
    Dim oBOM As BOM
    Set oBOM = oDoc.ComponentDefinition.BOM
    
    oBOM.StructuredViewFirstLevelOnly = False
    oBOM.StructuredViewEnabled = True

    'Set a reference to the "Structured" BOMView
    Dim oBOMView As BOMView
    Set oBOMView = oBOM.BOMViews.Item("Strukturiert")
    
    Dim bomlist() As String
    ReDim bomlist(0 To 0, 0 To 2) As String
    
    bomexportarray darray:=bomlist, PN:=oDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value, Desc:=oDoc.PropertySets.Item("Design Tracking Properties").Item("Description").Value, QTY:="1"

    Call BomRecurse(oBOMView.BOMRows, bomlist)
    
    If (bomlist(0, 0) <> "") Then
        
        
        QuickSort2D SortArray:=bomlist, col:=0, L:=LBound(bomlist, 1), R:=UBound(bomlist, 1), bAscending:=True
        Dim xlsApp As Excel.Application
        Set xlsApp = CreateObject("excel.application")
        xlsApp.Visible = True
        
        Dim objWorkbook As Excel.Workbook
        Set objWorkbook = Excel.Workbooks.Add 'Workbooks.Open(myFile)
        Dim objworksheet As WorkSheet
        Set objworksheet = objWorkbook.Worksheets("Tabelle1")
        
        'Find first empty row for adding to existing spreadsheet
        num = 1
        While (objworksheet.Cells(num, 1) <> "")
            num = num + 1
        Wend
                        
        For L = LBound(bomlist, 1) To UBound(bomlist, 1)
            objworksheet.Cells(num, 1).Value = bomlist(L, 0)
            objworksheet.Cells(num, 2).Value = bomlist(L, 1)
            objworksheet.Cells(num, 3).Value = bomlist(L, 2)
            num = num + 1
        Next L

        'objWorkbook.Close True
       
        'MsgBox ("Export complete")
    Else
        'MsgBox ("Zero Items Exported")
    End If
 
End Sub
Function TransposeDim(v() As String)
' Custom Function to Transpose a 0-based array (v)

    Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim TempArray() As String

    Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)

    ReDim TempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            TempArray(X, Y) = v(Y, X)
        Next Y
    Next X

    TransposeDim = TempArray
End Function
Function bomexportarray(darray() As String, PN As String, Desc As String, QTY As String)
    num = IsInArray(darray, PN, 0)
    If (num = False) Then
        Dim temp() As String
        temp = TransposeDim(darray)
        num = UBound(temp, 2) + IIf(temp(0, 0) <> "", 1, 0)
        ReDim Preserve temp(0 To 2, 0 To num) As String
        darray = TransposeDim(temp)
        darray(UBound(darray, 1), 0) = PN
        darray(UBound(darray, 1), 1) = Desc
        darray(UBound(darray, 1), 2) = QTY

    Else:
        darray(num, 2) = CInt(darray(num, 2)) + CInt(QTY)
    End If
End Function

Private Sub BomRecurse(oBOMRows As BOMRowsEnumerator, bomlist() As String, Optional SubQty As Integer = 1)
    On Error Resume Next
    ' Iterate through the contents of the BOM Rows.
    Dim i As Long
    For i = 1 To oBOMRows.Count
        ' Get the current row.
        Dim oRow As BOMRow
        Set oRow = oBOMRows.Item(i)

        'Set a reference to the primary ComponentDefinition of the row
        Dim oCompDef As ComponentDefinition
        Set oCompDef = oRow.ComponentDefinitions.Item(1)
            
        Dim oPartNumProperty As String
        Dim oDescripProperty As String
        Dim oVendorProperty As String
            
        If (TypeOf oCompDef Is VirtualComponentDefinition) Then
        
            oPartNumProperty = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
            oDescripProperty = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Description").Value
        
            bomexportarray darray:=bomlist, PN:=oPartNumProperty, Desc:=oDescripProperty, QTY:=oRow.ItemQuantity * SubQty
        Else
                    
            oPartNumProperty = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
            oDescripProperty = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Description").Value
        
            bomexportarray darray:=bomlist, PN:=oPartNumProperty, Desc:=oDescripProperty, QTY:=oRow.ItemQuantity * SubQty
                
            'Recursively iterate child rows if present.
            If Not oRow.ChildRows Is Nothing Then Call BomRecurse(oRow.ChildRows, bomlist, oRow.ItemQuantity * SubQty)
        End If
    Next
End Sub

Function IsInArray(sarray() As String, stext As String, Optional column As Integer = -1)
'Assumes array is arr(rows,columns) and column is zero if array is zero based
'Returns false if nothing found, returns row number if found
    If (column = -1) Then
        For i = LBound(sarray) To UBound(sarray)
            If (stext = sarray(i)) Then
                IsInArray = i
                Exit For
            End If
        Next i
    ElseIf (column <> -1) Then
        For i = LBound(sarray, 1) To UBound(sarray, 1)
            If (stext = sarray(i, column)) Then
                IsInArray = i
                Exit For
            End If
        Next i
    Else:
    IsInArray = False
    End If
End Function

Sub QuickSort2D(SortArray, col, L, R, bAscending)
    'Originally Posted by Jim Rech 10/20/98 Excel.Programming
    'Modified to sort on first column of a two dimensional array
    'Modified to handle a second dimension greater than 1 (or zero)
    'Modified to do Ascending or Descending
    Dim i, j, X, Y, mm

    i = L
    j = R
    X = SortArray((L + R) / 2, col)
    If bAscending Then
        While (i <= j)
            While (SortArray(i, col) < X And i < R)
                i = i + 1
            Wend
            While (X < SortArray(j, col) And j > L)
                j = j - 1
            Wend
            If (i <= j) Then
                For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
                    Y = SortArray(i, mm)
                    SortArray(i, mm) = SortArray(j, mm)
                    SortArray(j, mm) = Y
                Next mm
                i = i + 1
                j = j - 1
            End If
        Wend
    Else
        While (i <= j)
            While (SortArray(i, col) > X And i < R)
                i = i + 1
            Wend
            While (X > SortArray(j, col) And j > L)
                j = j - 1
            Wend
            If (i <= j) Then
                For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
                    Y = SortArray(i, mm)
                    SortArray(i, mm) = SortArray(j, mm)
                    SortArray(j, mm) = Y
                Next mm
                i = i + 1
                j = j - 1
            End If
        Wend
    End If
    If (L < j) Then Call QuickSort2D(SortArray, col, L, j, bAscending)
    If (i < R) Then Call QuickSort2D(SortArray, col, i, R, bAscending)
End Sub

Betreff: Inventor Stückliste Stückzahl der Baugruppen

Anonymous — Fri, 12 Jan 2018 07:08:27 GMT

Hallo,

Leider hat mir VBA ein paar mehr fehler angezeigt. Das was eingekreist ist, musste ich umändern, dann hat das Programm es erkannt.

Im ersten Bild, die Zeile die Gelb ist. Ist auch ein Fehler, ich komm nicht weiter. Ich weiß nicht wie ich die Zeile ändern muss damit VBA es erkennt.

Ich bitte um Hilfe.

Ich habe gesehen, dass das Makro bei Ihnen im Bild auch die Einzelteile mit rein nimmt. Wo kann ich das Makro ändern damit er NUR die .iam entnimmt. Also nur die Baugruppen, darum geht es eigentlich.

Ich danke im voraus für Ihre Hilfestellung!

Betreff: Inventor Stückliste Stückzahl der Baugruppen

Juergen_Wagner — Fri, 12 Jan 2018 07:14:07 GMT

Fehlermeldung: Referenz auf Excel fehlt. Siehe hier am Ende des Beitrags unter der Überschrift

Verweise (Referenzen) https://inventorfaq.blogspot.de/2017/03/inventor-automatisieren-programmieren_27.html

Wenn ich Zeit habe, schaue ich nach der Frage zur Anzeige der Baugruppe.

Betreff: Inventor Stückliste Stückzahl der Baugruppen

Juergen_Wagner — Fri, 12 Jan 2018 07:27:33 GMT

Nur IAMs (siehe Kommenrar 'NUR IAMS) und kleiner Bugfix. Code oben öffnet 2 Excel, also diesen nicht verwenden

'Quelle https://forums.autodesk.com/t5/inventor-customization/vba-counting-quantity-of-parts-in-assemblies/td-p/5666311
'Leicht angepast von JW
Public Sub bomexport()
'Dim myFile As String
''Pfad zu XLS-Vorlagendateien
'myFile = "c:\_temp_permanent\test.xlsx"
        
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveEditDocument
    
    ' Set a reference to the BOM
    Dim oBOM As BOM
    Set oBOM = oDoc.ComponentDefinition.BOM
    
    oBOM.StructuredViewFirstLevelOnly = False
    oBOM.StructuredViewEnabled = True

    'Set a reference to the "Structured" BOMView
    Dim oBOMView As BOMView
    Set oBOMView = oBOM.BOMViews.Item("Strukturiert")
    
    Dim bomlist() As String
    ReDim bomlist(0 To 0, 0 To 2) As String
    
    bomexportarray darray:=bomlist, PN:=oDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value, Desc:=oDoc.PropertySets.Item("Design Tracking Properties").Item("Description").Value, QTY:="1"

    Call BomRecurse(oBOMView.BOMRows, bomlist)
    
    If (bomlist(0, 0) <> "") Then
        
        
        QuickSort2D SortArray:=bomlist, col:=0, L:=LBound(bomlist, 1), R:=UBound(bomlist, 1), bAscending:=True
        Dim xlsApp As Excel.Application
        Set xlsApp = CreateObject("excel.application")
        xlsApp.Visible = True
        
        Dim objWorkbook As Excel.Workbook
        Set objWorkbook = xlsApp.Workbooks.Add 'Workbooks.Open(myFile)
        Dim objworksheet As WorkSheet
        Set objworksheet = objWorkbook.Worksheets("Tabelle1")
        
        'Find first empty row for adding to existing spreadsheet
        num = 1
        While (objworksheet.Cells(num, 1) <> "")
            num = num + 1
        Wend
                        
        For L = LBound(bomlist, 1) To UBound(bomlist, 1)
            objworksheet.Cells(num, 1).Value = bomlist(L, 0)
            objworksheet.Cells(num, 2).Value = bomlist(L, 1)
            objworksheet.Cells(num, 3).Value = bomlist(L, 2)
            num = num + 1
        Next L

        'objWorkbook.Close True
       
        'MsgBox ("Export complete")
    Else
        'MsgBox ("Zero Items Exported")
    End If
 
End Sub
Function TransposeDim(v() As String)
' Custom Function to Transpose a 0-based array (v)

    Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim TempArray() As String

    Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)

    ReDim TempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            TempArray(X, Y) = v(Y, X)
        Next Y
    Next X

    TransposeDim = TempArray
End Function
Function bomexportarray(darray() As String, PN As String, Desc As String, QTY As String)
    num = IsInArray(darray, PN, 0)
    If (num = False) Then
        Dim temp() As String
        temp = TransposeDim(darray)
        num = UBound(temp, 2) + IIf(temp(0, 0) <> "", 1, 0)
        ReDim Preserve temp(0 To 2, 0 To num) As String
        darray = TransposeDim(temp)
        darray(UBound(darray, 1), 0) = PN
        darray(UBound(darray, 1), 1) = Desc
        darray(UBound(darray, 1), 2) = QTY

    Else:
        darray(num, 2) = CInt(darray(num, 2)) + CInt(QTY)
    End If
End Function

Private Sub BomRecurse(oBOMRows As BOMRowsEnumerator, bomlist() As String, Optional SubQty As Integer = 1)
    On Error Resume Next
    ' Iterate through the contents of the BOM Rows.
    Dim i As Long
    For i = 1 To oBOMRows.Count
        ' Get the current row.
        Dim oRow As BOMRow
        Set oRow = oBOMRows.Item(i)

        'Set a reference to the primary ComponentDefinition of the row
        Dim oCompDef As ComponentDefinition
        Set oCompDef = oRow.ComponentDefinitions.Item(1)
            
        Dim oPartNumProperty As String
        Dim oDescripProperty As String
        Dim oVendorProperty As String
            
        If (TypeOf oCompDef Is VirtualComponentDefinition) Then
        
            oPartNumProperty = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
            oDescripProperty = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Description").Value
        
            bomexportarray darray:=bomlist, PN:=oPartNumProperty, Desc:=oDescripProperty, QTY:=oRow.ItemQuantity * SubQty
        Else
            
            'NUR IAMS
            If oCompDef.Type = kAssemblyComponentDefinitionObject Then 'Nur Komponenten vom Typ Assembly berücksichtigen
            
                oPartNumProperty = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
                oDescripProperty = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Description").Value
        
                bomexportarray darray:=bomlist, PN:=oPartNumProperty, Desc:=oDescripProperty, QTY:=oRow.ItemQuantity * SubQty
            End If  'ENDE NUR IAMS
           
            'Recursively iterate child rows if present.
            If Not oRow.ChildRows Is Nothing Then Call BomRecurse(oRow.ChildRows, bomlist, oRow.ItemQuantity * SubQty)
        End If
    Next
End Sub

Function IsInArray(sarray() As String, stext As String, Optional column As Integer = -1)
'Assumes array is arr(rows,columns) and column is zero if array is zero based
'Returns false if nothing found, returns row number if found
    If (column = -1) Then
        For i = LBound(sarray) To UBound(sarray)
            If (stext = sarray(i)) Then
                IsInArray = i
                Exit For
            End If
        Next i
    ElseIf (column <> -1) Then
        For i = LBound(sarray, 1) To UBound(sarray, 1)
            If (stext = sarray(i, column)) Then
                IsInArray = i
                Exit For
            End If
        Next i
    Else:
    IsInArray = False
    End If
End Function

Sub QuickSort2D(SortArray, col, L, R, bAscending)
    'Originally Posted by Jim Rech 10/20/98 Excel.Programming
    'Modified to sort on first column of a two dimensional array
    'Modified to handle a second dimension greater than 1 (or zero)
    'Modified to do Ascending or Descending
    Dim i, j, X, Y, mm

    i = L
    j = R
    X = SortArray((L + R) / 2, col)
    If bAscending Then
        While (i <= j)
            While (SortArray(i, col) < X And i < R)
                i = i + 1
            Wend
            While (X < SortArray(j, col) And j > L)
                j = j - 1
            Wend
            If (i <= j) Then
                For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
                    Y = SortArray(i, mm)
                    SortArray(i, mm) = SortArray(j, mm)
                    SortArray(j, mm) = Y
                Next mm
                i = i + 1
                j = j - 1
            End If
        Wend
    Else
        While (i <= j)
            While (SortArray(i, col) > X And i < R)
                i = i + 1
            Wend
            While (X > SortArray(j, col) And j > L)
                j = j - 1
            Wend
            If (i <= j) Then
                For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
                    Y = SortArray(i, mm)
                    SortArray(i, mm) = SortArray(j, mm)
                    SortArray(j, mm) = Y
                Next mm
                i = i + 1
                j = j - 1
            End If
        Wend
    End If
    If (L < j) Then Call QuickSort2D(SortArray, col, L, j, bAscending)
    If (i < R) Then Call QuickSort2D(SortArray, col, i, R, bAscending)
End Sub

Betreff: Inventor Stückliste Stückzahl der Baugruppen

Anonymous — Fri, 12 Jan 2018 10:24:37 GMT

Hallo @Juergen_Wagner,

das funktioniert super mit dem Makro :))

Ich danke Ihnen wirklich sehr!!

Mfg,

Ptach

Betreff: Inventor Stückliste Stückzahl der Baugruppen

Juergen_Wagner — Fri, 12 Jan 2018 10:56:10 GMT

Bitte, gerne! und: wir duzen uns hier, dass "Ihnen" ist nicht notwendig.