---

Hallo Forum
Ich habe vor längerer Zeit ein VBA-Programm geschrieben das mir aus einer geöffneten Baugruppe eine komplette angepasste Stückliste als .txt Datei exportiert.
Darin sind alle Teile und Baugruppen mit allen Unterbaugruppen  usw. enthalten.
Das Funktioniert und passt auch.
Durch eine Umstellung unseres ERP-System brauche ich jetzt aber nicht eine Datei mit allen Teilen sondern für jede Baugruppe eine eigene Stücklistendatei.

Ich könnte jetzt alle Baugruppen öffnen und die Stückliste mit meinem VBA-Programm exportieren, aber das will ich mir ersparen.
Gibt es da einen kurzen Weg über eine Inventor-Funktion????... oder einen längeren Weg über den Stücklisten Eintrag „oBomRow.ItemNumber“ (also 1.1, 1.2.1, 1.2.3.1, … ihr wisst schon…).
Habt ihr ein Programmbeispiel wie ich mit dieser „ItemNumber“ umgehen kann???

3D-User

Zur Orientierung hier mein jetziges Exportprogramm:

Code:

---

Option Explicit
Dim PMarke As String
Dim PMarkeH As String
Dim AXArray(5000, 20) As String
Dim iZeile As Integer

Public Sub Dyn365out()
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = ThisApplication.ActiveDocument
    Dim oBOM As BOM
    Set oBOM = oAsmDoc.ComponentDefinition.BOM
    oBOM.StructuredViewFirstLevelOnly = False
    oBOM.StructuredViewEnabled = True
    Dim oStructuredBOMView As BOMView
    Set oStructuredBOMView = oBOM.BOMViews.Item("Strukturiert")
    Dim byWert As Byte
    Dim oPfad As String
    Dim uFolder, FileName, oFolderAXS As String
   
    'ExportPfad zuweisen
    oFolderAXS = "C:\ExportAX\"

    'Hinweisfenster ob der Stücklistenexport gestartet werden soll
    byWert = MsgBox("Soll die Stückliste exportiert werden?", vbOKCancel, "Stücklistenexport")
    If byWert = 2 Then Exit Sub

    Erase AXArray  'AXArray wird gelöscht
    iZeile = 2      'Zeile 0 und 1 werden separat erzeugt
 
    'die Teileliste aus der .iam wird angepasst und in das AXArray geschrieben
    addRow "", oStructuredBOMView.BOMRows, True
 
    'Ordner und Datei für das Exportfile wird erstellt
    uFolder = Mid(AXArray(2, 2), 3, 3)
    oPfad = oFolderAXS & uFolder
    Call CreateFolder.CreateFolder(oPfad)
    FileName = oPfad & "\" & Mid(AXArray(2, 2), 3, Len(AXArray(2, 2)) - 2) & " Rev" & AXArray(2, 9) & ".txt"
   
    'AXArray wird in eine .txt Datei exportiert
    Open FileName For Output As #1
        Dim i As Integer
        For i = 1 To iZeile  '1= mit Spaltenüberschriften, 2= ohne Spaltenüberschriften
            Print #1, AXArray(i, 1) & "|" & AXArray(i, 2) & "|" & AXArray(i, 3) & "|" & AXArray(i, 4) & "|" & AXArray(i, 5) _
            & "|" & AXArray(i, 6) & "|" & AXArray(i, 7) & "|" & AXArray(i, 8) & "|" & AXArray(i, 9) _
            & "|" & AXArray(i, 10) & "|" & AXArray(i, 11) & "|" & AXArray(i, 12) & "|" & AXArray(i, 13) _
            & "|" & AXArray(i, 14) & "|" & AXArray(i, 15) & "|" & AXArray(i, 16) & "|" & AXArray(i, 17) _
            & "|" & AXArray(i, 18) & "|" & AXArray(i, 19) & "|" & AXArray(i, 20)
        Next i
    Close #1 'Export-Datei schließen
 
  'Hinweisfenster oder Notepad zum Ende des Exports anzeigen
    'MsgBox "Stücklistenexport war erfolgreich!", vbOKOnly, "Stücklistenexport"
    Shell ("notepad.exe " + FileName)
End Sub

Private Function addRow(Parent As String, oBomRows As BOMRowsEnumerator, Optional header As Boolean = False)
    Dim oPart As Document
    Set oPart = ThisApplication.ActiveDocument
    Dim oBomRow As BOMRow
    Dim TName As String
    Dim oFileNameIDW As String
    Dim oTextBSZ, Temp As String
    Dim HauptBG, UnterBG, TNummer As String
    Dim NameEng, NameFra, oRevNum As String
    On Error Resume Next
   
    'Header wird erstellt (nur beim 1. drchlauf)
    If header = True Then
        'Zeile 1 = Spaltenüberschriften
        AXArray(1, 1) = "Pos"
        AXArray(1, 2) = "HauptBG"
        AXArray(1, 3) = "Anz"
        AXArray(1, 4) = "Teilenummer"
        AXArray(1, 5) = "Benennung"
        AXArray(1, 6) = "Englisch"
        AXArray(1, 7) = "Französisch"
        AXArray(1, 8) = "Unterbenennung"
        AXArray(1, 9) = "Rev"
        AXArray(1, 10) = "Erstelldatum"
        AXArray(1, 11) = "Material/Norm"
        AXArray(1, 12) = "MatNummer"
        AXArray(1, 13) = "Länge"
        AXArray(1, 14) = "Breite"
        AXArray(1, 15) = "Werkstoff"
        AXArray(1, 16) = "Rohteilgewicht"
        AXArray(1, 17) = "Bauteilgewicht"
        AXArray(1, 18) = "Artikelstatus"
        AXArray(1, 19) = "Zusatztext"
        AXArray(1, 20) = "Speicherort"
       
        'Zeile 2 = Die oberste Hauptbaugruppe wird erstellt
        Temp = BulTools.Translate(oPart.PropertySets(1).Item("Title").Value, NameEng, NameFra)
        PMarkeH = oPart.PropertySets(4).Item("Produktmarke").Value
        HauptBG = oPart.PropertySets(3).Item("Part Number").Value
       
        AXArray(2, 1) = "0"
        AXArray(2, 2) = PMarkeH & HauptBG
        AXArray(2, 3) = "1"
        AXArray(2, 4) = PMarkeH & HauptBG
        AXArray(2, 5) = oPart.PropertySets(1).Item("Title").Value
        AXArray(2, 6) = NameEng
        AXArray(2, 7) = NameFra
        AXArray(2, 8) = oPart.PropertySets(1).Item("Subject").Value
        AXArray(2, 9) = oPart.PropertySets(1).Item("Revision Number").Value
        AXArray(2, 10) = Left(oPart.PropertySets(3).Item("Creation Time").Value, 10)
        AXArray(2, 11) = ""
        AXArray(2, 12) = ""
        AXArray(2, 13) = ""
        AXArray(2, 14) = ""
        AXArray(2, 15) = ""
        AXArray(2, 16) = ""
        AXArray(2, 17) = Round(oPart.PropertySets(3).Item("Mass").Value / 1000, 1)
        AXArray(2, 18) = oPart.PropertySets(4).Item("Artikelstatus").Value
        AXArray(2, 19) = ""
        AXArray(2, 20) = oPart.ComponentDefinitions(1).Document.FullDocumentName
    End If
   
    'Prüft ob die Unterbaugruppe schon in der Stückliste ist, wenn ja wird sie kein 2. Mal ins Array geschrieben
    Dim i As Integer
    Dim InPartList As Boolean
    InPartList = False
    PMarke = oBomRow.ComponentDefinitions(1).Document.PropertySets(4).Item("Produktmarke").Value
    For i = 2 To iZeile
        If AXArray(i, 2) = PMarke & Parent And Not AXArray(i, 2) = "" Then
            InPartList = True
        End If
    Next i

    'geamte Teileliste durchlaufen
    For Each oBomRow In oBomRows
        'Prüfen ob das Teil von der AX-Stückliste ausgeschlossen ist
        If oBomRow.ComponentDefinitions(1).Document.PropertySets(4).Item("NoAXBom").Value = False Then
            'prüfen ob das Teiln schon in der Stückliste enthalten ist
            If InPartList = False Then
               
                'Variablen werden zurückgesetzt
                iZeile = iZeile + 1
                NameEng = ""
                NameFra = ""
                PMarke = ""
                TNummer = ""
                TName = ""
               
                'prüfen ob es ein "Parent" gibt, wenn nicht ist die Hauptbaugruppe der "Parent"
                UnterBG = Parent
                If UnterBG = "" Then UnterBG = HauptBG
               
                ' Stückliste wird zusammengestellt in in das Array geschrieben
                TNummer = oBomRow.ComponentDefinitions(1).Document.PropertySets(3).Item("Part Number").Value
                TName = oBomRow.ComponentDefinitions(1).Document.PropertySets(1).Item("Title").Value
                oRevNum = oBomRow.ComponentDefinitions(1).Document.PropertySets(1).Item("Revision Number").Value
                PMarke = oBomRow.ComponentDefinitions(1).Document.PropertySets(4).Item("Produktmarke").Value
                If PMarke = "" Then PMarke = BulTools.ProduktMa(TNummer)
                Temp = BulTools.Translate(TName, NameEng, NameFra)
               
                'Zusatztext für Brennschnitte aus der .idw auslesen
                oFileNameIDW = Left(oBomRow.ComponentDefinitions(1).Document.FullDocumentName, Len(oBomRow.ComponentDefinitions(1).Document.FullDocumentName) - 3) & "idw"
                oTextBSZ = BulTools.iPropTextBSZ(oFileNameIDW)
                                 
                'AXArray wird mit Daten gefüllt
                AXArray(iZeile, 1) = oBomRow.ItemNumber
                AXArray(iZeile, 2) = PMarkeH & UnterBG
                AXArray(iZeile, 3) = oBomRow.ItemQuantity
                AXArray(iZeile, 4) = PMarke & TNummer
                AXArray(iZeile, 5) = TName
                AXArray(iZeile, 6) = NameEng
                AXArray(iZeile, 7) = NameFra
                AXArray(iZeile, 8) = oBomRow.ComponentDefinitions(1).Document.PropertySets(1).Item("Subject").Value
                AXArray(iZeile, 9) = oRevNum
                AXArray(iZeile, 10) = Left(oBomRow.ComponentDefinitions(1).Document.PropertySets(3).Item("Creation Time").Value, 10)
                AXArray(iZeile, 11) = oBomRow.ComponentDefinitions(1).Document.PropertySets(4).Item("Material/Norm").Value
                AXArray(iZeile, 12) = ""
                AXArray(iZeile, 13) = oBomRow.ComponentDefinitions(1).Document.PropertySets(4).Item("Länge").Value
                AXArray(iZeile, 14) = oBomRow.ComponentDefinitions(1).Document.PropertySets(4).Item("Breite").Value
                AXArray(iZeile, 15) = oBomRow.ComponentDefinitions(1).Document.PropertySets(3).Item("Material").Value
                AXArray(iZeile, 16) = oBomRow.ComponentDefinitions(1).Document.PropertySets(4).Item("Gewicht").Value
                AXArray(iZeile, 17) = Round(oBomRow.ComponentDefinitions(1).Document.PropertySets(3).Item("Mass").Value / 1000, 1)
                AXArray(iZeile, 18) = oBomRow.ComponentDefinitions(1).Document.PropertySets(4).Item("Artikelstatus").Value
                AXArray(iZeile, 19) = oTextBSZ
                AXArray(iZeile, 20) = oBomRow.ComponentDefinitions(1).Document.FullDocumentName
               
                'Materialnummer aus ExcelTabelle auslesen (Material/Norm und Material)
                AXArray(iZeile, 12) = BulTools.RMNummer(AXArray(iZeile, 11), AXArray(iZeile, 15))
            End If
           
            'Baugruppen mit der Kennung "NoAxBomDissolve = True" werden nicht aufgelöst
            If oBomRow.ComponentDefinitions(1).Document.PropertySets(4).Item("NoAxBomDissolve").Value = False Then
                If Not oBomRow.ChildRows Is Nothing Then addRow TNummer, oBomRow.ChildRows, False
            End If
        End If
ForNext:
    Next
End Function

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

du könntest
1. in der IAM-Stückliste in allen Ebenen alle IAM ermitteln, die nicht unteilbar oder Referenz sind.
  Diese IAM in ein Array eintragen.
2. für alle IAM des Arrays die IAM-Stückliste (nur 1 Ebene) auswerten und in die entsprechende txt-Datei schreiben.

------------------
Gruß Roland

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo RolandD
Danke für deinen Vorschlag.
Ich hab’s schon so versucht, konnte dabei aber die Unterbaugruppen nicht auflösen.
Ich brauche aber von allen Unterbaugruppen eine vollständige Stückliste.

Ich denke es ist vielleicht einfacher mit Hilfe der „ItemNumber“ die Stücklisten zu extrahieren.
Vielleicht so:
- Zuerst alle Zeilen die mit „1“ anfangen (also 1.1, 1.2, 1.3, ……) in eine Stückliste schreiben.
  Wobei immer die erste Zeile mit „1“ die Baugruppe definiert (Name und Speicherort)
- Dann kommt die zweite Ebene (1.1, 1.2, 1.3….), dann die dritte (1.1.3, 1.1.4,…) usw.
  Auch da definiert immer die erste Zeile einer Ebene die Baugruppe.
- Anschließend das Ganze mit den Zeilen die mit 2, 3, 4, 5… anfangen.

Sollte eigentlich so funktionieren, oder?

3D-User

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Stucklsite.jpg

Hallo Forum

Ich hab jetzt einmal einen Ersten Lösungsansatz für das Stücklisten Sortierproblem entwickelt.
Ich sortiere nach der „ItemNumber“ der Stückliste aus einer Baugruppe.
Ganz ohne Sortierung sind diese „ItemNumber“ ziemlich durcheinander.

Mit Bordeigenen Mitteln wird die Stückliste schon viel besser, aber die Nummerierung ist noch nicht korrekt.

Code:

---

Call oBOMView.Sort("Objekt", True)
Call oBOMView.Renumber(1, 1)

---

Mit meinem kleinen Programm kann ich nun die gesamte Stückliste, die ich in ein Array eingelesen habe nach dem ersten Nummernblock sortieren.
Das Ergebnis ist schon ganz gut, nur manchmal stimmt die Reihenfolge in der anderen Nummernblöcken nicht.
Mit Nummernblöcken meine ich z.B.: „0.2.8.5.“ der erste Block wäre hier die „2“
(Im Beispielbild ist die Reihenfolge zufällig richtig)

Vielleich kann jemand mit besseren Programmierkenntnissen als ich das Programm so weiterentwickeln das auch die übrigen Blöcke perfekt aufsteigend sortiert werden.

Code:

---

Private Sub AXArraySorten()
    Dim Muster As Integer
    Dim UnsortListe As Integer
    Dim SpalteNr As Integer
    Dim ZeileNr As Integer
    Dim StrukturStr, AXSpalte, AXZeile As Integer
   
    'Startparameter wird festgelegt
    ZeileNr = 3
   
    'AXArray wird nach dem Ersten Ziffenblock sortiert und in das "AXArraySort" geschrieben
    For Muster = 0 To iZeile
        For UnsortListe = 3 To iZeile
            For StrukturStr = 3 To Len(AXArray(UnsortListe, 1))
                If Mid(AXArray(UnsortListe, 1), StrukturStr, 1) = "." Then
                    If CInt(Mid(AXArray(UnsortListe, 1), 3, StrukturStr - 3)) = Muster Then
                        For SpalteNr = 1 To 23
                            AXArraySort(ZeileNr, SpalteNr) = AXArray(UnsortListe, SpalteNr)
                        Next SpalteNr
                        ZeileNr = ZeileNr + 1
                    End If
                    Exit For
                End If
            Next StrukturStr
        Next UnsortListe
    Next Muster
       
    'das "AXArraySort" wird wieder in das "AXArray" zurückgeschrieben
    For AXZeile = 3 To iZeile
        For AXSpalte = 1 To 23
            AXArray(AXZeile, AXSpalte) = AXArraySort(AXZeile, AXSpalte)
        Next AXSpalte
    Next AXZeile
    Erase AXArraySort

---

3D-User

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP