---

Hallo.
Ich möchte aus einer Baugruppe alle Einzelteile in Step abspeichern.
Die Bezeichnung soll von den Einzelteilen übernommen werde.
Die Möglichkeit das über die Aufgabenplanung zu realisieren gibt es in Inventor 2018 leider nicht.

Hat da jemand eine Möglichkeit? Kann mir jemand helfen?

Vielen Dank!
Falko

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

---

https://ww3.cad.de/foren/ubb/Forum258/HTML/001648.shtml#000000

------------------
Gruß KraBBy

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

---

Ja genau diese Problem hat auch "Michael John"
"die Step Datei vom Einzelteil der geöffneten Baugruppe "

Falko

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

---

Moin 

Code:

---

Public Sub ExportToSTEP()

Dim fso As Object
Dim ret As Variant

For Each odoc In ThisApplication.Documents
    If (odoc.DocumentType = kAssemblyDocumentObject Or odoc.DocumentType = kPartDocumentObject) Then
        Set fso = CreateObject("Scripting.FilesystemObject")
        Set dDoc = ThisApplication.ActiveDocument
        If odoc Is Nothing Then Exit Sub
            If Len(Trim(odoc.FullFileName)) > 0 Then
                outFile = fso.GetParentFolderName(odoc.FullFileName) & "\" & fso.GetBaseName(odoc.FullFileName) & ".stp"
 
    ' Get the STEP translator Add-In.
    Dim oSTEPTranslator As TranslatorAddIn
    Set oSTEPTranslator = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
 
 
    Dim oContext As TranslationContext
    Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
    oContext.Type = kFileBrowseIOMechanism
 
    Dim oOptions As NameValueMap
    Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
 
    Dim oDataMedium As DataMedium
    Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
 
    oDataMedium.fileName = outFile
 
    If oSTEPTranslator.HasSaveCopyAsOptions(odoc, oContext, oOptions) Then
        ' Set application protocol.
        ' 2 = AP 203 - Configuration Controlled Design
        ' 3 = AP 214 - Automotive Design
        oOptions.Value("ApplicationProtocolType") = 3

        ' Other options...
        'oOptions.Value("Author") = ""
        'oOptions.Value("Authorization") = ""
        'oOptions.Value("Description") = ""
        'oOptions.Value("Organization") = ""

        oContext.Type = kFileBrowseIOMechanism
     
    Call oSTEPTranslator.SaveCopyAs(odoc, oContext, oOptions, oDataMedium)
            Else
                MsgBox "Erst alles Speichern", vbInformation
                Exit Sub
            End If
        End If
  End If
Next

End Sub

---

Waren nur kleine Anpassungen nötig, kann man auch noch bereinigen.

Das Objekt dDoc ist beispielsweise gar nicht notwendig.
Ausgabepfad ist immer der jeweilige Speicherort der Originaldatei, wenn es immer der gleiche Pfad sein soll muss das noch angepasst werden. Ansonsten, viel Vergnügen.

Gruß

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

---

Hi,
wie müsste dass angepasst werden wenn ich mehrere Gleichteile habe aber jedes Teil als Step ausgeben möchte.
Gruß

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

---

Moin 

Für mein Verständnis ein Fallbeispiel:
Eine sehr vereinfachte Baugruppe eines Autos, bestehend aus 4 Rädern, 1 Karosserie, 1 Lenkrad und 2 Sitzen.
Dann willst du insgesamt 8 step Dateien erhalten?

Für den Fall musst du eine Regelung für folgendes Problem wählen:
Das Windows-Dateisystem erlaubt keine Dateien mit gleichen Namen in gleichem Ordner.

Entweder wird jede Kopie anders benannt → "Rad-1" "Rad-2" "Rad-3" "Rad-4"
oder du speicherst alles in verschiedene Ordner.

Soweit so einfach. Da ist dann aber noch die Frage wie mit Unterbaugruppen verfahren werden soll.
Beispielsweise hat jeder Sitz noch jeweils 2 identische Kippschalter. Gesamtanzahl an step Dateien: 12 ?
Weiter durchnummerieren ("Rad-1" "Rad-2" "Rad-3" "Rad-4") oder mit Ordnern arbeiten? Oder Unterbaugruppen nur die Baugruppe als step speichern?

Da ich den Anwendungsfall nicht kenne, kann ich direkte keine Empfehlung abgeben.
Was am einfachsten sein wird, ist programmatisch die Stückliste (BOM) durchzugehen, die Bauteile durchzunummerieren und auszugeben.
Für Unterbaugruppen braucht es eine rekursive Funktion.

Ich hoff das war jetzt nicht zu verwirrend  , grob gesagt: um überhaupt eine Skizzierung des Programms vorzunehmen bräuchte es noch mehr Informationen.

Gruß

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

---

Hallo,
genau so sollte der Aufbau sein.
Alle Teile der Baugruppe auch Teile von Unterbaugruppen.
Wie geschrieben: Rad_01, Rad_02...usw.
Hättest Du ein Beispiel wie man dies umsetzen kann!?

Danke und Gruß

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

---

Ein direktes Beispiel nicht.
Hab aber gerade etwas auf Mod the Machine gefunden das passen könnte, funktioniert zwar ohne BOM aber mit ein bisschen Anpassung ist das brauchbar.
http://modthemachine.typepad.com/my_weblog/2009/03/accessing-assembly-components.html

Code:

---

Public Sub GetPartOccurrences()
    ' Get the active assembly.
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = ThisApplication.ActiveDocument

    ' Get the assembly component definition.
    Dim oAsmDef As AssemblyComponentDefinition
    Set oAsmDef = oAsmDoc.ComponentDefinition

    ' Get all of the leaf occurrences of the assembly.
    Dim oLeafOccs As ComponentOccurrencesEnumerator
    Set oLeafOccs = oAsmDef.Occurrences.AllLeafOccurrences

    ' Iterate through the occurrences and print the name.
    Dim oOcc As ComponentOccurrence
    For Each oOcc In oLeafOccs
        Debug.Print oOcc.Name
    Next
End Sub

---

wenn dir den Beitrag duchliest wirst du das Ergebnis sehen:

Zitat:

---

Floor:1
CurvedSupport:1
CurvedSupport:2
ArchTop:1
CurvedSupport:1
CurvedSupport:2
ArchTop:1
Pillar:1
Pillar:2
Pillar:3
Pillar:4
Inventor:1

---

Da müsstest jetzt anpassen, dass "CurvedSupport" weitergezählt wird.
Am sichersten wäre, im Dateisystem die vorhandenen Dateien zu erfassen und darauf aufbauend weiter zu zählen. → Achtung! Gefahr dass zu viele Dateien erstellt werden wenn man zweimal drauf drückt.
Verhindern ließe sich das durch: Löschen aller step dateien in den entsprechenden Ordnern, muss am Anfang passieren. Prüfung wie alt die Step dateien sind und wenn nicht aktuell dann löschen, das kann man auch in die "For Each oOcc In oLeafOccs " schleife packen.
Code um den Erstellzeitpunkt zu bekommen:
https://www.mrexcel.com/forum/excel-questions/73458-read-external-file-properties-date-created-using-vba.html

Code:

---

Sub GetDateCreated()

    Dim oFS As Object
    Dim strFilename As String

    'Put your filename here
    strFilename = "c:\excel stuff\commandbar info.xls"

    'This creates an instance of the MS Scripting Runtime FileSystemObject class
    Set oFS = CreateObject("Scripting.FileSystemObject")

    MsgBox strFilename & " was created on " & oFS.GetFile(strFilename).DateCreated

    Set oFS = Nothing

End Sub

---

Code für das durchlaufen der Dateien:
http://codevba.com/office/loop_files_in_folder.htm#.Wt79osiFPg4

Code:

---

Dim strFileName As String
'TODO: Specify path and file spec
Dim strFolder As String: strFolder = "C:\temp\"
Dim strFileSpec As String: strFileSpec = strFolder & "*.*"
Dim FileList() As String
Dim intFoundFiles As Integer
strFileName = Dir(strFileSpec)
Do While Len(strFileName) > 0
    ReDim Preserve FileList(intFoundFiles)
    FileList(intFoundFiles) = strFileName
    intFoundFiles = intFoundFiles + 1
    strFileName = Dir
Loop

---

Um die Zahl am Ende des Namens zu erhalten, hier eine Funktion von mir:

Code:

---

    Function Get_Numeric_End(ByVal oString As String) As Integer

        Dim i As Integer
        Dim Tempstring As String

        If oString <> "" Then
            For i = 1 To Len(oString)
                If IsNumeric(Right(oString, Len(oString) - (Len(oString) - i))) Then
                    Tempstring = (Right(oString, Len(oString) - (Len(oString) - i)))
                Else
                    If Tempstring = "" Then
                        Get_Numeric_End = 0
                        Exit For
                    Else
                    Get_Numeric_End = CInt(Tempstring)
                        Exit For
                    End If
                End If
            Next i
        End If

    End Function

---

was du jetzt machen müsstest wäre:
GetPartOccurrences hernehmen und hier anpassen:

Code:

---

    For Each oOcc In oLeafOccs
        Debug.Print oOcc.Name
    Next

---

In die Schleife muss rein:
1. Dateisystem durchsuchen, die höchste Zahl für die entsprechende Komponente erhalten, daraus den neuen Namen erstellen (höchste Zahl +1) → "Rad_1"
2. Der angepasste Step Export Code (odoc muss auf jeden fall geändert werden und der Speichername)

So im Groben wäre mein erster Ansatz.

Gruß

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

---

In welchem Koordinatensystem sollte der Export erfolgen? Rad_01, Rad_02 ... macht mE nur Sinn, wenn das mit den Koordinaten der Baugruppe exportiert werden soll (ansonsten unterscheiden sich ja die Rädern nur im Dateinamen)

Dann wäre eine Schleife über alle Occurrences denkbar
Ausgangspunkt: alle Komponenten unsichtbar;
For Each oOcc In ThisApplication.ActiveDocument.ComponentDefinition.Occurrences;
nur die aktuelle oOcc sichtbar schalten;
Bgr. exportieren (es wird nur sichtbares exportiert, Dateiname oOcc.Name ggf. gefiltert);
oOcc wieder unsichtbar;
Next

------------------
Gruß KraBBy

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

---

@Tacker
Vielen Dank für die Beispiele werde versuchen daraus etwas zusammen zu kopieren.
Unities sind raus...

@KraBBy
Es sollten die Koordinaten der Baugruppen verwendet weden.

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

---

aha, wichtige Info!

das hier könnte durchlaufen (ist es auch in meinem kleinen Test)

Code:

---

Sub Test_ExpBgr2Stp()
' exportiert alle Komp. einer Bgr, im KS der Bgr!
'
' KraBBy 24.04.2018

    Dim sPfad As String, sDatName As String
    sPfad = "C:\temp\TestExp\"  'hier Export-Pfad angeben!
    'Prüfung ob Pfad existiert nötig? -> Nein, wird ggf. erstellt
   
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument
   
    'alle Komp. unsichtbar schalten, Status merken
    Dim oOcc As ComponentOccurrence
    Dim i As Integer, iMax As Integer
    iMax = oDoc.ComponentDefinition.Occurrences.Count
    Dim bSichtbar() As Boolean
    ReDim bSichtbar(1 To iMax)
   
    For i = 1 To iMax
        Set oOcc = oDoc.ComponentDefinition.Occurrences.Item(i)
        If oOcc.Visible Then
            oOcc.Visible = False
            bSichtbar(i) = True
        Else
            bSichtbar(i) = False
        End If
    Next 'i
   
    'Schleife für eigentlichen Export
    For Each oOcc In oDoc.ComponentDefinition.Occurrences
        oOcc.Visible = True
        sDatName = oOcc.Name
        sDatName = clear_DatName(sDatName)     'unzulässige Zeichen f. Dateinamen entfernen
        sDatName = NextFreeFileName(sPfad, sDatName, "stp") 'einzigartigen Dateinamen erz.
        Call ExportToSTEP(sPfad, sDatName, oDoc)
        oOcc.Visible = False
    Next 'oOcc
   
    'Sichtbarkeit wiederherstellen
    For i = 1 To iMax
        Set oOcc = oDoc.ComponentDefinition.Occurrences.Item(i)
        If bSichtbar(i) Then oOcc.Visible = True Else oOcc.Visible = False
    Next 'i
   
End Sub

Private Function NextFreeFileName(sPfad As String, sDatName As String, sFileExtension As String) As String
' hängt einen Zähler an den Dateinamen, falls die Datei bereits existiert
'   sPfad: Pfad mit "\" am Ende
'   sDatName: Dateiname ohne Datei-Endung
'   sFileExtension: Dateiendung ohne Punkt!
' Rückgabewert: sDatName mit angehängtem Zähler
' KraBBy 24.04.2018

    Dim i As Integer
    Dim i2 As String
    Dim filename As String
    filename = sPfad & sDatName & "." & sFileExtension
    If Dir(filename) = "" Then  'vorgeschlagener Name existiert noch nicht
        NextFreeFileName = sDatName 'Rückgabewert ist Eingabewert
        Exit Function
    End If
   
    For i = 1 To 99 Step 1  'prüft, ob die Datei "filename" (fortlaufende nr.)existiert, erste freie Nr. wird verwendet
        If i < 10 Then
            i2 = "0" + CStr(i)
        Else
            i2 = "" + CStr(i)
        End If
        filename = sPfad & sDatName & "_" & i2 & "." & sFileExtension
        If Dir(filename) = "" Then Exit For
        ' (wenn filename nicht existiert, wird leerer String zurückgegeben)
    Next
   
    NextFreeFileName = sDatName & "_" & i2  'Rückgabewert mit "gefundenem" Dateinamen
End Function

Function clear_DatName(Str As String) As String
    ' wandelt einen gegebenen Text in einen "konformen Text"
    ' dieser neue Wert wird zurückgegeben
   
    Dim name_alt As String
    Dim name_neu As String
   
    name_alt = Str
   
    name_neu = Replace(name_alt, " ", "_")      'alle Leerz. ersetzen
    'name_neu = Replace(name_neu, "-", "_")      'Bindestriche ersetzen
    name_neu = Replace(name_neu, ".", "_")      'Punkte ersetzen
    name_neu = Replace(name_neu, ",", "_")
    name_neu = Replace(name_neu, "ä", "ae")     'Umlaute...
    name_neu = Replace(name_neu, "Ä", "Ae")
    name_neu = Replace(name_neu, "ö", "oe")
    name_neu = Replace(name_neu, "Ö", "Oe")
    name_neu = Replace(name_neu, "ü", "ue")
    name_neu = Replace(name_neu, "Ü", "Ue")
    name_neu = Replace(name_neu, "ß", "ss")
   
    name_neu = Replace(name_neu, "^", "_")
    name_neu = Replace(name_neu, "°", "_")
    name_neu = Replace(name_neu, """", "_")     'Anführungszeichen (")
    'name_neu = Replace(name_neu, "§", "_")
    'name_neu = Replace(name_neu, "$", "_")
    'name_neu = Replace(name_neu, "%", "_")
    'name_neu = Replace(name_neu, "&", "_")
    name_neu = Replace(name_neu, "/", "_")  ' nicht für Dateinamen zugelassen
    name_neu = Replace(name_neu, "\", "_")  ' nicht für Dateinamen zugelassen
    name_neu = Replace(name_neu, "=", "_")
    name_neu = Replace(name_neu, "?", "_")  ' nicht für Dateinamen zugelassen
    name_neu = Replace(name_neu, "*", "_")  ' nicht für Dateinamen zugelassen
    name_neu = Replace(name_neu, "~", "_")
    name_neu = Replace(name_neu, "<", "_")  ' nicht für Dateinamen zugelassen
    name_neu = Replace(name_neu, ">", "_")  ' nicht für Dateinamen zugelassen
    name_neu = Replace(name_neu, "|", "_")  ' nicht für Dateinamen zugelassen
    name_neu = Replace(name_neu, ":", "_")  ' nicht für Dateinamen zugelassen
   
    name_neu = Replace(name_neu, "[", "(")
    name_neu = Replace(name_neu, "]", ")")
   

    dErsetzen name_neu 'Sub, doppelte __ ersetzen, rekursiv
   
    'Rückgabewert
    clear_DatName = name_neu
   
End Function

Private Sub dErsetzen(ByRef txt)
' doppelte Unterstriche "__" werden durch einfache "_" ersetzt
' rekursiv
    If Not (0 = InStr(txt, "__")) Then
        txt = Replace(txt, "__", "_")   'doppelte __ ersetzen
    End If
    If Not (0 = InStr(txt, "__")) Then dErsetzen txt 'Rekursion
End Sub

Public Sub ExportToSTEP(Optional sPfad As String, Optional sDatName As String, Optional oDok As Document)
' aus der Hilfe zum "TranslatorAddIn Interface" eingefügt
' und angepasst
' KraBBy 10.06.2014
'
' Parameter:
'   sPfad mit \ am Ende
'   sDatName ohne Dateiendung
'   oDok Verweis auf Dokument, das exportiert werden soll
'
' ------------------------ SRe

If "" = sPfad Then
    sPfad = "C:\Temp\"
    sDatName = "temptest"
End If

If "Nothing" = TypeName(oDok) Then  'wenn referenz nicht übergeben wird (weil optional)
    Set oDok = ThisApplication.ActiveDocument
End If
   
    ' Get the STEP translator Add-In.
    Dim oSTEPTranslator As TranslatorAddIn
    Set oSTEPTranslator = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")

    If oSTEPTranslator Is Nothing Then
        MsgBox "Could not access STEP translator."
        Exit Sub
    End If

    Dim oContext As TranslationContext
    Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
    Dim oOptions As NameValueMap
    Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
    If oSTEPTranslator.HasSaveCopyAsOptions(oDok, oContext, oOptions) Then
        ' Set application protocol.
        ' 2 = AP 203 - Configuration Controlled Design
        ' 3 = AP 214 - Automotive Design
        ' 4 = AP 214 - Automotive Design International Standard
        oOptions.Value("ApplicationProtocolType") = 4
        oOptions.Value("export_fit_tolerance") = 0.001    ' "Standard"
       
        ' Other options...
        oOptions.Value("Author") = "-Makro-"
        'oOptions.Value("Authorization") = ""
        'oOptions.Value("Description") = ""
        'oOptions.Value("Organization") = ""

        oContext.Type = kFileBrowseIOMechanism

        Dim oData As DataMedium
        Set oData = ThisApplication.TransientObjects.CreateDataMedium
        oData.filename = sPfad & sDatName & ".stp"

        On Error Resume Next
        Call oSTEPTranslator.SaveCopyAs(oDok, oContext, oOptions, oData)
       
        If Err.Number = 0 Then
            'MsgBox "Export erfolgt" & vbCrLf & oData.filename, vbInformation, "STEP Fertig"
            gsFertigMsg = gsFertigMsg & sDatName & ".stp" & vbCrLf
            '[...]
            '[...]
        Else
            MsgBox "Fehler bei STEP:" & vbCrLf & Err.Description, vbCritical, "Fehler:" & Err.Number
        End If
    End If
   
    'Aufräumen
    Set oSTEPTranslator = Nothing
    Set oContext = Nothing
    Set oOptions = Nothing
    Set oData = Nothing
   
End Sub

---

Variable "gsFertigMsg" ist für eine Schlussmeldung gedacht, die ich aber hier im aufrufenden Sub nicht eingebaut habe.

Edit: es ist keine Routine für Unterbaugruppen vorhanden! dh. eine Unterbaugruppe wird so exportiert, wie sie ist (als Bgr., Sichtbarkeiten etc.)

------------------
Gruß KraBBy

[Diese Nachricht wurde von KraBBy am 24. Apr. 2018 editiert.]

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

---

@KraBBy
Danke schön!
Unities sind raus...leider nicht mehr als 10.

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

---

@Tacker
Vielen Dank!

Gruß Falko

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