---

Hallo Viel-Mehr-Wissende...

Wir erstellen die Drehteile als ipt so, dass:
1. der rotationssymetrische Drehbereich inkl. Toleranzen kommt, dann
2. ein unterdrücktes Trennen auf XY-Ebene mit Name "DT ENDE" (=Drehteil Ende) und
3. die anschließende Fräsbearbeitung.

Wir machen dies Procedere, um die Kontur in der CNC-Abteilung einlesen zu können.
Dazu setzen wir
A. das Bauteilende hoch, direkt unterhalb von DT ENDE
B. heben die Unterdrückung von DT ENDE auf (Schnittansicht)
C. Schalten alle Toleranzen auf Median
D. Aktualisieren das Modell (damit das Volumenmodell auf Median geschaltet wird) und
E. Speichern dieses Modell als STP und natürlich
F. machen diese Änderung komplett rückgängig bzw. beenden ohne Speichern.

Dies ist natürlich ein ziemlicher Brocken, aber vielleicht könnt Ihr mir ja bei einigen Bröckchen weiterhelfen, so dass ich alles zusammenstellen kann....

Danke schonmal im Voraus,
Stefan...

------------------
IV2008

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

---

Hi

Im einfachsten Fall (ohne jede Fehlerprüfung) sollte es so gehen. Würde man das Dokument einfach ohne Speichern schließen mit "oDoc.Close(True)", könnte man auch die Transaktion und das Aktualisieren des Views weglassen.

Code:

---

Private Sub Main()

Dim oApp As Application
Set oApp = ThisApplication

Dim oDoc As PartDocument
Set oDoc = oApp.ActiveDocument

'Transaction vorbereiten
Dim oTransGeom As TransientGeometry
Set oTransGeom = ThisApplication.TransientGeometry

'Transaction starten
Dim oTrans As Transaction
Set oTrans = ThisApplication.TransactionManager.StartTransaction(oDoc, "Export als Step")

Dim oCompDef As PartComponentDefinition
Set oCompDef = oDoc.ComponentDefinition

Dim oSplitFeature As SplitFeature
Set oSplitFeature = oCompDef.Features.SplitFeatures.Item("DT ENDE")

'Bauteilende unterhalb von DT ENDE setzen
Call oSplitFeature.SetEndOfPart(False)

'Unterdrückung aufheben
oSplitFeature.Suppressed = False

'Toleranz auf Median umstellen
Call oDoc.ComponentDefinition.Parameters.SetAllToMedian

'Aktualisieren
oDoc.Rebuild 'Eventuell reicht auch eine oDoc.Update

'Export als STEP
Call SaveAsSTP(oDoc)

'Transaction abbrechen --> so als wäre nix passiert
oTrans.Abort

'aktiven View updaten
oApp.ActiveView.Update

End Sub

Private Function SaveAsSTP(ByVal oDoc As PartDocument)

Dim fso As Object
Dim ret As Variant

Set fso = CreateObject("Scripting.FilesystemObject")
If oDoc Is Nothing Then Exit Function
If Len(Trim(oDoc.FullFileName)) > 0 Then
    outfile = fso.GetParentFolderName(oDoc.FullFileName) & "\" & fso.GetBaseName(oDoc.FullFileName) & ".stp"
                 
    ' Get the STP 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 Function
    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 oDataMedium As DataMedium
        Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
        oDataMedium.Filename = outfile

        Call oSTEPTranslator.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
    End If
Else
    MsgBox "Erst Speichern", vbInformation
    Exit Function
End If

End Function

---

------------------
MfG
Ralf

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

---

Hallo Ralf,

ich bin überwältigt über diesen Code, der perfekt arbeitet, effizient und einfach nur GENIAL ist.

Wie / Wo kann man solch geniales Programmieren von Inventor VBA lernen?

DANKE ! 
Stefan

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

---

Hi

Genial ist da nix. Probiere das Script mal in einem Bauteil ohne die Trennung aus. 

Inventor anwerfen, auf das kleine schwarze Dreieck neben dem Hilfezeichen klicken, unter "weitere Ressourcen" (oder so ähnlich) versteckt sich im Untermenü die Programmierungshilfe. Da finden sich auch eine Reihe Beispiele. Ansonsten Google'n und der Rest ist Erfahrung und Spieltrieb.

------------------
MfG
Ralf

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

---

Hallo Ralf, Hallo zusammen,

eine Nachfrage stellt sich mir noch:

Das Exportieren der STP klappt auch bei iPart-Bauteilen, d.h. das Modell ist richtig erstellt. Jedoch wird es unter dem Namen des Mutterbauteils gespeichert. :-(

Wie müßte der Code aussehen, dass bei einem iPart auch die Step-Datei den Dateinamen des aktivierten 'Kindes' trägt?

Ich habe wohl gesucht und gegoogelt, jedoch keine Infos gefunden.

Danke Euch,
Stefan

AIV2008SP3 mit XPPro

------------------
IV2008

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

---

Hi

Bin mir nicht ganz sicher, aber probier mal:

Code:

---

Private Sub Main()

Dim oApp As Application
Set oApp = ThisApplication

Dim oDoc As PartDocument
Set oDoc = oApp.ActiveDocument

'Transaction vorbereiten
Dim oTransGeom As TransientGeometry
Set oTransGeom = ThisApplication.TransientGeometry

'Transaction starten
Dim oTrans As Transaction
Set oTrans = ThisApplication.TransactionManager.StartTransaction(oDoc, "Export als Step")

Dim oCompDef As PartComponentDefinition
Set oCompDef = oDoc.ComponentDefinition

Dim oSplitFeature As SplitFeature
Set oSplitFeature = oCompDef.Features.SplitFeatures.Item("DT ENDE")

'Bauteilende unterhalb von DT ENDE setzen
Call oSplitFeature.SetEndOfPart(False)

'Unterdrückung aufheben
oSplitFeature.Suppressed = False

'Toleranz auf Median umstellen
Call oDoc.ComponentDefinition.Parameters.SetAllToMedian

'Aktualisieren
oDoc.Rebuild 'Eventuell reicht auch eine oDoc.Update

'Export als STEP
Call SaveAsSTP(oDoc)

'Transaction abbrechen --> so als wäre nix passiert
oTrans.Abort

'aktiven View updaten
oApp.ActiveView.Update

End Sub

Private Function SaveAsSTP(ByVal oDoc As PartDocument)

Dim fso As Object
Dim ret As Variant

Set fso = CreateObject("Scripting.FilesystemObject")
If oDoc Is Nothing Then Exit Function
If Len(Trim(oDoc.FullFileName)) > 0 Then
    If oDoc.ComponentDefinition.IsiPartFactory = True Then
        outfile = fso.GetParentFolderName(oDoc.FullFileName) & "\" & Replace(oDoc.ComponentDefinition.iPartFactory.DefaultRow.PartName, "ipt", ".stp")
    Else
        outfile = fso.GetParentFolderName(oDoc.FullFileName) & "\" & fso.GetBaseName(oDoc.FullFileName) & ".stp"
    End If
   
    ' Get the STP 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 Function
    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 oDataMedium As DataMedium
        Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
        oDataMedium.Filename = outfile

        Call oSTEPTranslator.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
    End If
Else
    MsgBox "Erst Speichern", vbInformation
    Exit Function
End If

End Function

---

------------------
MfG
Ralf

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

---

Hallo Ralf,

du kannst Dir sicher sein, es funktioniert klasse.

Beim Ausprobieren hatte ich jetzt noch ein Phänomen, dass das Kind des iParts hatte vorher mit 'Dateien erstellen' neu generiert hätte werden müssen.

Kann ich so etwas vor der Erstellung der stp erzwingen?

Bei der manuellen Nutzung von Inventor ist der Eintrag 'Dateien erstellen' im Kontextmenü manchmal nicht da, oder speichert nicht für mich sichtbar.
Von daher wäre eine erzwungene Neuerstellung der Datei natürlich die sichere Methode.

Weißt du das auch? :-)

Vielen, vielen Dank schonmal,
Stefan

------------------
IV2008

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

---

Hi

Versuchen wir's mal so:

Code:

---

Private Sub Main()

Dim oApp As Application
Set oApp = ThisApplication

Dim oDoc As PartDocument
Set oDoc = oApp.ActiveDocument

'Transaction vorbereiten
Dim oTransGeom As TransientGeometry
Set oTransGeom = ThisApplication.TransientGeometry

'Transaction starten
Dim oTrans As Transaction
Set oTrans = ThisApplication.TransactionManager.StartTransaction(oDoc, "Export als Step")

Dim oCompDef As PartComponentDefinition
Set oCompDef = oDoc.ComponentDefinition

If oDoc.ComponentDefinition.IsiPartFactory = True Then
    If Not CreateOrUpdateChild(oDoc) = True Then
        MsgBox "Fehler beim Erstellen / Aktualisieren des iPart-Kindes"
        oTrans.Abort
        Exit Sub
    End If
End If

Dim oSplitFeature As SplitFeature
Set oSplitFeature = oCompDef.Features.SplitFeatures.Item("DT ENDE")

'Bauteilende unterhalb von DT ENDE setzen
Call oSplitFeature.SetEndOfPart(False)

'Unterdrückung aufheben
oSplitFeature.Suppressed = False

'Toleranz auf Median umstellen
Call oDoc.ComponentDefinition.Parameters.SetAllToMedian

'Aktualisieren
oDoc.Rebuild 'Eventuell reicht auch eine oDoc.Update

'Export als STEP
Call SaveAsSTP(oDoc)

'Transaction abbrechen --> so als wäre nix passiert
oTrans.Abort

'aktiven View updaten
oApp.ActiveView.Update

End Sub

Private Function SaveAsSTP(ByVal oDoc As PartDocument)

Dim fso As Object
Dim ret As Variant

Set fso = CreateObject("Scripting.FilesystemObject")
If oDoc Is Nothing Then Exit Function
If Len(Trim(oDoc.FullFileName)) > 0 Then
    If oDoc.ComponentDefinition.IsiPartFactory = True Then
        outfile = fso.GetParentFolderName(oDoc.FullFileName) & "\" & Replace(oDoc.ComponentDefinition.iPartFactory.DefaultRow.PartName, "ipt", ".stp")
    Else
        outfile = fso.GetParentFolderName(oDoc.FullFileName) & "\" & fso.GetBaseName(oDoc.FullFileName) & ".stp"
    End If
   
    ' Get the STP 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 Function
    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 oDataMedium As DataMedium
        Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
        oDataMedium.Filename = outfile

        Call oSTEPTranslator.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
    End If
Else
    MsgBox "Erst Speichern", vbInformation
    Exit Function
End If

End Function

Private Function CreateOrUpdateChild(ByVal oDoc As PartDocument) As Boolean
    On Error Resume Next
    Err.Clear
   
    Dim oRow As iPartTableRow
    Set oRow = oDoc.ComponentDefinition.iPartFactory.DefaultRow
   
    oDoc.SelectSet.Clear
    Call oDoc.SelectSet.Select(oRow)
   
    Dim oControlDef As ControlDefinition
    Set oControlDef = ThisApplication.CommandManager.ControlDefinitions.Item("DeselSpawnCtxCmd")
       
    oControlDef.Execute
   
    If Err = 0 Then CreateOrUpdateChild = True
    On Error GoTo 0
End Function

---

------------------
MfG
Ralf

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

---

Hallo Ralf,

Danke für den schnellen Lösungsvorschlag.

Leider erhalte ich immer die Fehlermeldung, egal ob sich das iPart geändert hat oder nicht.

Es ist wohl der execute-Befehl, der den Fehler macht.

Wenn ich unter DeselSpawnCtxCmd die Hilfe befrage (gemäß Deiner Quellenangabe) oder google, dann finde ich nichts Geeignetes.

Liegt hier ein Tippfehler vor?!?!

Oder als Idee zum Thema: Kann ich den Status des iPart-Kindes auf false='nicht aktuell' setzen und dann neu erstellen?

Fragen über Fragen...

Danke für Deine Unterstützung,
Stefan

------------------
IV2008

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

---

Hi

Da ist kein Tipfehler (leider). Kannst du mir so ein Teil bei dem's schief geht hochladen?

Nochmal für mich zum Verständnis, das iPart soll vor oder nach dem Verschieben des Bauteilendes, Aufheben der Unterdrückung usw. exportiert werden?

------------------
MfG
Ralf

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

---

ST1035.zip

Hallo Ralf,

anbei das Bauteil ST1035 mit Unterordner der erstellten Kinder, sowie mein derzeit verwendetes Modul.

Damit die exportierte STP ganz aktuell ist, möchte ich die Aktualierung vor der Transaction aktualisieren. Siehe Modul.

Ich rufe das kombinierte Makro STP_pdf auf, da dies beim Bauteil die STP erstellt und bei einer Zeichnung eine pdf speichert.

Soweit der Stand...

Danke!
Stefan

------------------
IV2008

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

---

Hi

Auch mit deinem Bauteil und Code tritt bei mir kein Fehler auf. Kannst du mal prüfen, ob Inventor2008 den Befehl DeselSpawnCtxCmd kennt? Einfach mal die Sub ausführen.

Code:

---

Private Sub test()

Dim oControldef As ControlDefinition
For Each oControldef In ThisApplication.CommandManager.ControlDefinitions
    If oControldef.InternalName = "DeselSpawnCtxCmd" Then
        MsgBox "Gefunden"
    End If
Next
   
End Sub

---

Sollte der nicht gefunden werden, könnte es sein das der früher anders lautete. Halte ich aber für unwahrscheinlich.

------------------
MfG
Ralf

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

---

Hallo Ralf,

der test ist positiv, es gibt den DeselSpawnCtxCmd in 2008.

Ich habe den Test mal in die CreateOrUpdateChild-Function integriert und die Fehlerbehandlung geändert.
Da zeigt sich, dass der Fehler in der Zeile

Code:

---

    Call oDoc.SelectSet.Select(oRow)

---

auftritt.

Code:

---

Private Function CreateOrUpdateChild(ByVal oDoc As PartDocument) As Boolean
    Err.Clear
    On Error GoTo ErrorCreateOrUpdateChild
   
    Dim oRow As iPartTableRow
    Set oRow = oDoc.ComponentDefinition.iPartFactory.DefaultRow
   
    oDoc.SelectSet.Clear
    Call oDoc.SelectSet.Select(oRow)
   
    Dim oControldef As ControlDefinition
    'Set oControldef = ThisApplication.CommandManager.ControlDefinitions.Item("DeselSpawnCtxCmd")
    For Each oControldef In ThisApplication.CommandManager.ControlDefinitions
        If oControldef.InternalName = "DeselSpawnCtxCmd" Then
            oControldef.Execute
            'MsgBox "Gefunden"
        End If
    Next
    CreateOrUpdateChild = False
    On Error GoTo 0
    Exit Function
   
ErrorCreateOrUpdateChild:
    On Error GoTo 0
    CreateOrUpdateChild = True
End Function

---

Hast Du da noch einen Tipp?!?!

Danke für Deine Ausdauer,
Stefan

------------------
IV2008

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

---

Hallo

Dann setze mal bitte im VBA-Editor einen Haltepunkt auf die Zeile und lege eine Überwachung für oRow an. Wenn der Fehler auftritt, prüfe mal den Inhalt von oRow. Ich vermute die Variable ist dann leer, nur warum weiß ich im Moment noch nicht.

------------------
MfG
Ralf

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

---

Hallo Ralf,

oRow=Nothing - gut vermutet.

Nur warum, dass weiß ich auch nicht 

Mein googlen brachte auch keinen Erkenntnisgewinn... hmm

Was nun?

Gruß,
Stefan

------------------
IV2008

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

---

Hallo

Du hast weiter oben erwähnt das manchmal der Eintrag "Dateien erstellen" im Kontextmenü fehlt. Die Ursache dafür könnte auch die Ursache für den Fehler sein. Es wäre daher interessant genau so ein Teil mal unter die Lupe zu nehmen.
Ansonsten kann man nur eine Prüfung einbauen, ob oRow leer ist und die Funktion vorzeitig verlassen.

------------------
MfG
Ralf

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

---

Hallo Ralf, hallo zusammen,

ich hatte schon mal füher versucht, die Systematik zu verstehen, warum "Dateien erstellen" mal fehlt und mal nicht.

Die Logik hat sich mir nie erschlossen... Kann mir da jemand helfen?

Wie kann ich erzwingen, dass das Kind eines iParts neu erstellt wird?

Ratlos,...
Stefan

------------------
IV2008

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