---

Guten Tag VBA begabte.

Ich nehme mir immer mal wieder vor den Umgang mit VBA zu lernen. Bin allerdings immer noch nicht wirklich weiter damit, weswegen ich euch jetzt noch mal nerven muss.

Ich hatte durch eure Hilfe schon Macros zusammengeflickt und bekommen, mit denen ich sämtliche geöffnete Zeichnungen als DWG, oder PDF, oder DXF oder alles drei auf einmal exportieren kann.

Kann man so etwas auch mit Steps hinbekommen?

Also das jedes geöffnete Modell (egal ob Baugruppe oder Bauteil) als Step exportiert wird. Ich habe mal grob versucht mir nach Vorlage von den Makros die ich bereits habe was zusammen zu fummeln, was aber natürlich nicht funktioniert hat.

Code:

---

Sub Step_Export()
If ThisApplication.Documents.Count = 0 Then
        MsgBox "Kein Dokument offen", 16, "Error"
Exit Sub
 
    End If
 
Dim dDoc As Object

Dim fso As Object
Set fso = CreateObject("Scripting.FilesystemObject")

Dim ret As Variant
For Each dDoc In ThisApplication.Documents
    If dDoc.DocumentType = kPartDocumentObject Then
        Set fso = CreateObject("Scripting.FilesystemObject")
        Call dDoc.Activate
        Set dDoc = ThisApplication.ActiveDocument
        If dDoc Is Nothing Then Exit Sub
            If Len(Trim(dDoc.FullFileName)) > 0 Then
                outFile = fso.GetParentFolderName(dDoc.FullFileName) & "\" & fso.GetBaseName(dDoc.FullFileName) & ".stp"

    End If
    dDoc.SaveAs outFile, True
Else
        MsgBox "Erst Speichern", vbInformation
End If
MsgBox "STEPs wurden erfolgreich unter  - C:\Exchange - gespeichert"
End Sub

---

Ich hoffe ich mache mich mit dem was da oben steht nicht all zu lächerlich unter euch Profis. 

Beste Grüße
Chris

------------------
Mit freundlichen Grüßen

Chris

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

---

Warum nimmst du denn nicht das Beispiel aus der Hilfe?

Code:

---

Public Sub ExportToSTEP()
    ' 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(ThisApplication.ActiveDocument, 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

        Dim oData As DataMedium
        Set oData = ThisApplication.TransientObjects.CreateDataMedium
        oData.FileName = "C:\temptest.stp"

        Call oSTEPTranslator.SaveCopyAs(ThisApplication.ActiveDocument, oContext, oOptions, oData)
    End If
End Sub

---

------------------
MFG

Chris

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

---

Weil ich damit bloß aus dem aktuell aktiven Modell eine STEP exportiere, aber nicht aus sämtlichen geöffneten Modellen.

------------------
Mit freundlichen Grüßen

Chris

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

---

Wäre das hier vielleicht ein Ansatz?

Code:

---

Dim oDoc as Document
For Each oDoc in Thisapplication.Documents

DER CODE AUS DEM BEISPIEL

Next

---

------------------
MFG

Chris

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

---

Sowas steht nirgends in der Inventor Hilfe.
Ich habe so gut wie keine Ahnung von VBA und komme deswegen in dieses Forum. Wenn es dich nervt auf (deiner Meinung nach) dumme Fragen zu antworten, dann mach es einfach nicht, oder sag mir wo ich es nachlesen kann!

------------------
Mit freundlichen Grüßen

Chris

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

---

Tut mir leid, wenn du dir auf den Schlips getreten fühlst. Ich habe nur versucht, dir einen Lösungsansatz zu geben. Leider kann ich nicht riechen, wie viel oder wenig Ahnung du von VBA hast. Du schreibst, dass du dir schon ein paar Macros zusammenstellen konntest. Woher soll ich wissen, wie du das gemacht hast und wieviel davon deine eigene Kreation ist.

Du hast recht, dass sowas nicht in der Hilfe zu Inventor steht. Aber ich gehe davon aus, dass wenn man etwas nicht versteht, oder man mit einer Sache nichts anfangen kann, dass man dann entweder hier wieder zurückfragt, oder kurz Google bemüht, was recht schnell zu einer Lösung führen dürfte.

Und nur nebenbei: Ich bin sicher nicht genervt von irgendeiner Frage. Und in meinen Augen gibt es sehr sehr selten dumme Fragen, denn nur durch Fragen kann man das lernen, was man NOCH nicht weiß. Wir standen alle mal am Anfang und mussten Fragen stellen, die den Profis sicherlich sonnenklar waren. Aber selbst diese Profis mussten mal klein anfangen!

------------------
MFG

Chris

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

---

Tut mir ebenfalls leid, gleich so los gemault zu haben.
Hat sich eh schon erledigt.

------------------
Mit freundlichen Grüßen

Chris

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

---

Kein Problem.

Was bedeutet denn hat sich erledigt?
Konntest du dein Problem lösen, oder brauchst du den Code nicht mehr?

Bei einer Lösung wäre es schön, wenn du die Lösung hier posten würdest, damit andere mit ähnlichen Problemen dadurch Hilfestellung bekommen.

------------------
MFG

Chris

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

---

Hallo Chris 31

Ne. Ich dachte man könnte das vielleicht auch einfach mit dem Aufgabenplaner machen, doch das geht leider auch nicht.

------------------
Mit freundlichen Grüßen

Chris

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

---

Also brauchst du jetzt doch wieder Hilfe bei deinem Code?

------------------
MFG

Chris

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

---

Peinlich Peinlich 

Ich hatte die Diskussion hier damals total aus den Augen verloren und stehe jetzt wieder vor dem gleichen Problem...
Kann mir jemand helfen?
Mein Wissen um VBA ist leider noch nicht sonderlich gewachsen.

------------------
Mit freundlichen Grüßen

Chris

__________________________________

"Faulheit ist das Bestreben, mit möglichst wenig Aufwand viel zu erreichen. "

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

---

Ich habe es noch einmal Versucht und nun folgenden Blödsinn produziert.

Natürlich funktioniert es nicht, aber ich weiß nicht wieso.

Attribute VB_Name = "Module1"
Public Sub ExportToSTEP()
Dim oDoc As Assembly
Dim dDoc As AssemblyDocument
Dim fso As Object
Dim ret As Variant
For Each oDoc In ThisApplication.Assembly
    If oDoc.DocumentType = kAssemblyDocumentObject Then
        Set fso = CreateObject("Scripting.FilesystemObject")
        Call oDoc.Activate
        Set dDoc = ThisApplication.ActiveDocument
        If dDoc Is Nothing Then Exit Sub
            If Len(Trim(dDoc.FullFileName)) > 0 Then
                outFile = fso.GetParentFolderName(dDoc.FullFileName) & "\" & fso.GetBaseName(dDoc.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(ThisApplication.ActiveDocument, 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(ThisApplication.ActiveDocument, oContext, oOptions, oDataMedium)
            Else
                MsgBox "Erst alles Speichern", vbInformation
                Exit Sub
            End If
        End If
  End If
Next

End Sub

[Diese Nachricht wurde von Kizz am 02. Feb. 2017 editiert.]

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

---

Hallo,

Ich habe dir dein Programm umgeschrieben, so geht es

Code:

---

Public Sub ExportToSTEP()

Dim fso As Object
Dim ret As Variant

For Each oDoc In ThisApplication.Documents
    If oDoc.DocumentType = kAssemblyDocumentObject Then
        Set fso = CreateObject("Scripting.FilesystemObject")
        Set dDoc = ThisApplication.ActiveDocument
        If dDoc Is Nothing Then Exit Sub
            If Len(Trim(dDoc.FullFileName)) > 0 Then
                outFile = fso.GetParentFolderName(dDoc.FullFileName) & "\" & fso.GetBaseName(dDoc.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(ThisApplication.ActiveDocument, 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(ThisApplication.ActiveDocument, oContext, oOptions, oDataMedium)
            Else
                MsgBox "Erst alles Speichern", vbInformation
                Exit Sub
            End If
        End If
  End If
Next

End Sub

---

Gruß
Berno

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

---

Hallo Berno

Vielen Dank erst mal!
Ich habe das mal ausprobiert, aber es passiert einfach gar nichts. Mache ich etwas falsch?

------------------
Mit freundlichen Grüßen

Chris

__________________________________

"Faulheit ist das Bestreben, mit möglichst wenig Aufwand viel zu erreichen. "

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

---

Liegen die Steps im Ordner, mal nachgeschaut?

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

---

Ja.
Habe in dem Ordner nachgescheut in dem auch die Original IPT liegen, aber außer denen liegt dort keine weitere Datei. Habe natürlich mit dem Windows-Explorer geschaut und nicht mit IV 

------------------
Mit freundlichen Grüßen

Chris

__________________________________

"Faulheit ist das Bestreben, mit möglichst wenig Aufwand viel zu erreichen. "

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

---

Der Code oben erstellt nur STP Dateien für Baugruppen.

Wenn du den Code auch für Bauteile nutzen willst, ändere diese Zeile

If oDoc.DocumentType = kAssemblyDocumentObject Then

in

If (oDoc.DocumentType = kAssemblyDocumentObject Or oDoc.DocumentType = kPartDocumentObject) Then

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

---

PublicSubExportToSTEP.pdf

Hallo zusammen,
ich versuche gerade das Makro unten so zu verändern, das die Step Datei vom Einzelteil der geöffneten Baugruppe erzeugt wird. Wenn ich das Makro aus der Baugruppe heraus starte wird von der Baugruppe die Step Datei erzeugt. Wenn ich dann ein Bauteil aus der Baugruppe öffne und das Makro wieder starte wird dann auch von dem Einzelteil die Step Datei erzeugt.

die Auswahl das er kassemblydocumentobject oder kpartdocumentobject verwenden soll funktioniert so nicht.
Vielleicht kann mir ja einer weiter helfen.

Gruß
Michael John

------------------
Vielen Dank vorab und Gruß
Michael John

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

---

Hallo zusammen,

ich würde das Thema gerne noch einmal  aufgreifen
Der Code soll eine .stl Datei von jedem Bauteil einer offenen Baugruppe erzeugen.
Leider wird nur eine .stl der Baugruppe erzeugt aber die MsgBox wird passend zur Anzahl der Bauteile immer wieder angezeigt.
Ich würde mich freuen wenn jemand sagen könnte woran das liegt.

Danke und Gruß

Code:

---

Sub stl_Export()


Dim asmDoc As AssemblyDocument
    Set asmDoc = ThisApplication.ActiveDocument
 
    ' Iterate through all of the referenced documents at
    ' all levels of the assembly.
    Dim doc As Document
    For Each doc In asmDoc.AllReferencedDocuments
        ' Check for part documents.
        If doc.DocumentType = kPartDocumentObject Then
            ' Call the function to create the stl file.
            Call StlCreate(doc)
        End If
    Next
   
 
End Sub
   
  Private Sub StlCreate(part As PartDocument)
   
    Dim fso As Object
    Set fso = CreateObject("Scripting.FilesystemObject")

    Dim ret As Variant
    Set dDoc = ThisApplication.ActiveDocument

    Dim oModNr As Inventor.Property
    Set oModNr = dDoc.PropertySets(4).Item("cv1")

    Dim oRevNr As Inventor.Property
    On Error Resume Next
    Set oRevNr = dDoc.PropertySets(4).Item("cv2")

    If dDoc Is Nothing Then Exit Sub
    If Len(Trim(dDoc.FullFileName)) > 0 Then
    If oRevNr Is Nothing Then
        Dim FullDocName As String
        oFulldocName = dDoc.FullDocumentName
        Dim oArray() As String
        oArray = Split(oFulldocName, "\")
        Dim sName As String
        sName = oArray(LBound(oArray))
        sName = Left(sName, Len(sName) - 4)
        outfile = "C:\NC\TEILE" & "\" & sName & ".stl"
    Else
        outfile = "C:\NC\TEILE" & "\" & oModNr.Value & "_" & oRevNr.Value & ".stl"
    End If
    dDoc.SaveAs outfile, True
    Else
        MsgBox "Erst Speichern", vbInformation
    End If
    MsgBox "STL wurde erfolgreich unter  - C:\NC\TEILE - gespeichert"
     
   
   
End Sub

---

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

---

Fehler1803011950.pdf

Ist logisch, dass es nicht funktioniert...

Du übergibst an die Sub "StlCreate" das Bauteildokument mit "Call StlCreate(doc)", nutzt dieses aber dann überhaupt nicht in dem Sub.
Stattdessen erzeugst du mit "Set dDoc = ThisApplication.ActiveDocument" einen Verweis auf das aktive Dokument, also auf die aktive/geöffnete Baugruppe und speicherst diese dann später mit "dDoc.SaveAs".

Versuch mal folgenden Code:

Code:

---

Sub stl_Export()
Dim asmDoc As AssemblyDocument
    Set asmDoc = ThisApplication.ActiveDocument
 
    Dim doc As Document
    For Each doc In asmDoc.AllReferencepartuments
        If doc.DocumentType = kPartDocumentObject Then
            Call StlCreate(doc)
        End If
    Next
End Sub
   
Private Sub StlCreate(part As PartDocument)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FilesystemObject")

    Dim oModNr As Inventor.Property
    Set oModNr = part.PropertySets(4).Item("cv1")

    Dim oRevNr As Inventor.Property
On Error Resume Next
    Set oRevNr = part.PropertySets(4).Item("cv2")

    If Len(Trim(part.FullFileName)) > 0 Then
    If oRevNr Is Nothing Then
        Dim FullDocName As String
        oFulldocName = part.FullDocumentName
        Dim oArray() As String
        oArray = Split(oFulldocName, "\")
        Dim sName As String
        sName = oArray(LBound(oArray))
        sName = Left(sName, Len(sName) - 4)
        outfile = "C:\NC\TEILE" & "\" & sName & ".stl"
    Else
        outfile = "C:\NC\TEILE" & "\" & oModNr.Value & "_" & oRevNr.Value & ".stl"
    End If
    part.SaveAs outfile, True
    Else
        MsgBox "Erst Speichern", vbInformation
    End If

    MsgBox "STL wurde erfolgreich unter  - C:\NC\TEILE - gespeichert"
End Sub

---

------------------
Mit Besten Grüßen

Marcel

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

---

Danke schön!
Unities sind raus

[Diese Nachricht wurde von Goose am 02. Mrz. 2018 editiert.]

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