---

Guten Tag zusammmen,
wir kann mir einen kleinen Tip geben zum Thema. Export von Datei und einem Check ob der Dateiname bzw. die neuen ersten Stellen des Dateinames schon existieren. Falls ja soll die Datei gelöscht werden.

Hier mein Code snipsel

oContext.Type = kFileBrowseIOMechanism

        Dim oData As DataMedium
        Set oData = ThisApplication.TransientObjects.CreateDataMedium
        oData.filename = "G:\" & sPropValue & ".stp"
        'oData.filename = "C:\" & sPropValue & "_" & sPropValue1 & ".stp"

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

Vielen Dank schon mal für alle Tips

Gruss

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

BlueJay

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

---

Hallo

Kann denn die Datei (mit den neun ersten Stellen) mehrmals existieren?
Soll eine Meldung erscheinen, oder soll die Datei einfach gelöscht werden?

Gruss

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

---

Danke für die Fragen:
- die Datei kann nur einmal existieren und soll einfach gelöscht werden.

Gruss

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

BlueJay

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

---

Hallo

Sehe ich das richtig, dass du die STP-Files direkt im Root von G:\ speicherst?
Probier mal das hier

Code:

---

on error resume next
Dim pSTR As String
Dim strFile As String
       
'pSTR = sPath
pSTR = "G:\"
strFile = Left(Mid(oData.FileName, InStrRev(oData.FileName, "\") + 1), 9) & "*" & ".stp"
Kill Dir(pSTR & strFile)
err=0

---

Gruss

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

---

02-02-_2021_10-23-14.jpg

Vielen Dank für die Hilfe - habe es mit dem Code versucht aber ohne Erfolg.

Wie bekomme ich das Programm dazu - in einem festem Ordner die Dateinamen mit dem neuen Dateinamen (siehe Zeile) zu vergleichen und falls vorhanden (sieh angehängte Datei) zu löschen. Es soll immer nur der letzte Index im Verzeichniss bleiben.

oData.filename = "G:\CAD Vereinfachungen\" & sPropValue & "_" & sPropValue1 & ".stp"

Vielen Dank noch mal

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

BlueJay

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

---

Hallo,
Löschen, falls Datei vohanden:

Code:

---

If Dir(oData.FileName, vbNormal) > "" Then Kill (oData.FileName)

---

oder gleich Kill(oData.FileName), da musst du aber den Fehler abfangen, wenn die Datei nicht existieren sollte.

Anmerkung zum Step-Export: Der überschreibt doch sowieso eine existierende Datei (oder hat das irgendwo als Option)

Grüsse

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

---

Hallo

Deswegen habe ich ja oben gefragt, ob du direkt im Root speicherst.
Wenn der Speicherort immer derselbe ist, kannst du das im Code anpassen

Code:

---

pSTR = "G:\CAD Vereinfachungen\"

---

In der vorherigen Antwort hast du geschrieben, es existiere nur 1 Datei
Nun schreibst du, es soll nur immer der letzte Index bleiben?
Ist nicht dasselbe
Wo steht der Index?

Am besten postest du den ganzen Code, und schreibst nochmal dazu, was den jetzt genau passieren soll
Gruss

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

---

Hallo

Killt alle Files mit gleichem Namensmuster. Sollte VOR dem Export der neuen Version ausgeführt werden, sonst ist die gleich wieder mit weg.

Code:

---

Dim sFileName As String
sFileName = Dir("G:\CAD-Vereinfachungen" & "\" & sPropValue & "*.stp")

If Not sFileName = "" Then
    Kill "G:\CAD-Vereinfachungen\" & sFileName
    Do While sFileName <> ""
        sFileName = Dir
        Kill "G:\CAD-Vereinfachungen\" & sFileName
    Loop
End If

---

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

RKW Solutions GmbH
www.RKW-Solutions.com

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

---

Vielen Dank für deine Mühe und Entschuldigung für die villeicht komplizierte Beschreibung. Bin den Code gerade am zusammenflicken - lerne so auf dem Weg und durch Fragen (-:

anbei mein Code der folgende macht:
- macht von der geöffneten Baugruppe eine Vereinfachung
- zieht die Iprops der Baugruppe für den Dateinamen der Exportdatei (Aritkel Nr. und Index)
- Öffnet den Step Translater
- Speichert die Datei in einem festgelegtem Verzeichniss dem Dateinamen aus Artikelnummer und Index ab. (z.B 244.4400_01)

Was noch nicht funktioniert:
- Falls eine Datei am Anfang (Ziffern vor dem Unterstrich) schon in dem Pfad vorhanden ist, soll diese gelöscht werden. Es soll immer nur eine Datei mit dem höchsten Index in dem Pfad bleiben.

Ich hoffe das war etwas Verständlicher

Sub Export_Vereinfacht_Step_Sat()

    Dim oApp As Inventor.Application
    Set oApp = ThisApplication

    If oApp.ActiveDocument Is Nothing Then
    MsgBox "Kein Dokument geöffnet", vbInformation
    Exit Sub
    End If

    If oApp.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
    MsgBox "Die Funktion ist nur bei Baugruppen zulässig", vbInformation
    Exit Sub
    End If

' Set a reference to the active assembly document
    Dim oDoc As Inventor.Document
    Set oDoc = oApp.ActiveDocument

    Dim oDef As AssemblyComponentDefinition
    Set oDef = oDoc.ComponentDefinition
   
        Dim oProp As Property
        Dim sPropValue As String
     
       
        For Each oProp In oDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
        If oProp.Name = "Artikel-Nr." Then
        'If oProp.Name = "Anzeigename" Then
        sPropValue = Left(oProp.Value, 12)
       
    End If
Next

        For Each oProp In oDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
        Dim sPropValue1 As String
        If oProp.Name = "Index" Then
        sPropValue1 = oProp.Value
   
    End If
Next

' Create a new part document that will be the shrinkwrap substitute
    Dim oPartDoc As Inventor.PartDocument
    Set oPartDoc = oApp.Documents.Add(kPartDocumentObject)
   
    Dim oPartDef As PartComponentDefinition
    Set oPartDef = oPartDoc.ComponentDefinition

    Dim oDerivedAssemblyDef As DerivedAssemblyDefinition
    Set oDerivedAssemblyDef = oPartDef.ReferenceComponents.DerivedAssemblyComponents.CreateDefinition(oDoc.FullDocumentName)

' Options shrinkwrap_1
    'oDerivedAssemblyDef.DeriveStyle = kDeriveAsSingleBodyWithSeams
    oDerivedAssemblyDef.DeriveStyle = kDeriveAsSingleBodyNoSeams
    'oDerivedAssemblyDef.DeriveStyle = kDeriveAsWorkSurface
    'oDerivedAssemblyDef.DeriveStyle = kDeriveAsMultipleBodies
   
    oDerivedAssemblyDef.InclusionOption = kDerivedIncludeAll
 
' Options shrinkwrap_2
    oDerivedAssemblyDef.IncludeAllTopLevelWorkFeatures = kDerivedExcludeAll
    oDerivedAssemblyDef.IncludeAllTopLevelSketches = kDerivedExcludeAll
    oDerivedAssemblyDef.IncludeAllTopLeveliMateDefinitions = kDerivedExcludeAll
    oDerivedAssemblyDef.IncludeAllTopLevelParameters = kDerivedExcludeAll
       
' Options shrinkwrap_3
    'oDerivedAssemblyDef.ActiveDesignViewRepresentation = True
    'oDerivedAssemblyDef.ActivePositionalRepresentation = True
   
       
' Options shrinkwrap_4
 
    Call oDerivedAssemblyDef.SetRemoveByVisibilityOptions(kDerivedRemovePartsOnly, 2, False)
   
' Bauteile nach Größe
    Call oDerivedAssemblyDef.SetRemoveBySizeOptions(False)
    'Call oDerivedAssemblyDef.SetRemoveBySizeOptions(True, 2)
 
' Lochabdeckung
    Call oDerivedAssemblyDef.SetHolePatchingOptions(kDerivedPatchNone)
    'Call oDerivedAssemblyDef.SetHolePatchingOptions(kDerivedPatchRange, 0, 3)
   
' Skalierung
    'Call oDerivedAssemblyDef.ScaleFactor
' Spiegeln
    'Call oDerivedAssemblyDef.MirrorPlane=kDerivedPartMirrorPlaneXY
   
   
' Sonstiges
    oDerivedAssemblyDef.UseColorOverridesFromSource = False
    oDerivedAssemblyDef.ReducedMemoryMode = True
    oDerivedAssemblyDef.IndependentSolidsOnFailedBoolean = True
    oDerivedAssemblyDef.RemoveInternalVoids = True

' Create the shrinkwrap component
    Dim oDerivedAssembly As DerivedAssemblyComponent
    Set oDerivedAssembly = oPartDef.ReferenceComponents.DerivedAssemblyComponents.Add(oDerivedAssemblyDef)
    'oDerivedAssembly.BreakLinkToFile
   
   
' Set a reference to the active part document
    Dim oDoc2 As Inventor.PartDocument
    Set oDoc2 = oApp.ActiveDocument
   
' 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 "STEP Translater nicht aufrufbar."
        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
   

        oContext.Type = kFileBrowseIOMechanism

        Dim oData As DataMedium
        Set oData = ThisApplication.TransientObjects.CreateDataMedium
 
        oData.filename = "G:\CAD Vereinfachungen\" & sPropValue & "_" & sPropValue1 & ".stp"

        Call oSTEPTranslator.SaveCopyAs(ThisApplication.ActiveDocument, oContext, oOptions, oData)
    End If
   
   
    Call oDoc2.Close(True)
    'Call oDoc.Close(True)
       
       
    MsgBox "Die Vereinfachung wurde als Step und Sat Format unter -- G:\CAD Vereinfachungen -- gespeichert!!"
End Sub

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

BlueJay

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

---

Hallo

So sollte das funktionieren

Code:

---

Sub Export_Vereinfacht_Step_Sat()

    Dim oApp As Inventor.Application
    Set oApp = ThisApplication

    If oApp.ActiveDocument Is Nothing Then
    MsgBox "Kein Dokument geöffnet", vbInformation
    Exit Sub
    End If

    If oApp.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
    MsgBox "Die Funktion ist nur bei Baugruppen zulässig", vbInformation
    Exit Sub
    End If

' Set a reference to the active assembly document
    Dim oDoc As Inventor.Document
    Set oDoc = oApp.ActiveDocument

    Dim oDef As AssemblyComponentDefinition
    Set oDef = oDoc.ComponentDefinition
 
        Dim oProp As Property
        Dim sPropValue As String
   
     
        For Each oProp In oDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
        If oProp.Name = "Artikel-Nr." Then
        'If oProp.Name = "Anzeigename" Then
        sPropValue = Left(oProp.Value, 12)
     
    End If
Next

        For Each oProp In oDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
        Dim sPropValue1 As String
        If oProp.Name = "Index" Then
        sPropValue1 = oProp.Value
 
    End If
Next

' Create a new part document that will be the shrinkwrap substitute
    Dim oPartDoc As Inventor.PartDocument
    Set oPartDoc = oApp.Documents.Add(kPartDocumentObject)
 
    Dim oPartDef As PartComponentDefinition
    Set oPartDef = oPartDoc.ComponentDefinition

    Dim oDerivedAssemblyDef As DerivedAssemblyDefinition
    Set oDerivedAssemblyDef = oPartDef.ReferenceComponents.DerivedAssemblyComponents.CreateDefinition(oDoc.FullDocumentName)

' Options shrinkwrap_1
    'oDerivedAssemblyDef.DeriveStyle = kDeriveAsSingleBodyWithSeams
    oDerivedAssemblyDef.DeriveStyle = kDeriveAsSingleBodyNoSeams
    'oDerivedAssemblyDef.DeriveStyle = kDeriveAsWorkSurface
    'oDerivedAssemblyDef.DeriveStyle = kDeriveAsMultipleBodies
 
    oDerivedAssemblyDef.InclusionOption = kDerivedIncludeAll

' Options shrinkwrap_2
    oDerivedAssemblyDef.IncludeAllTopLevelWorkFeatures = kDerivedExcludeAll
    oDerivedAssemblyDef.IncludeAllTopLevelSketches = kDerivedExcludeAll
    oDerivedAssemblyDef.IncludeAllTopLeveliMateDefinitions = kDerivedExcludeAll
    oDerivedAssemblyDef.IncludeAllTopLevelParameters = kDerivedExcludeAll
     
' Options shrinkwrap_3
    'oDerivedAssemblyDef.ActiveDesignViewRepresentation = True
    'oDerivedAssemblyDef.ActivePositionalRepresentation = True
 
     
' Options shrinkwrap_4

    Call oDerivedAssemblyDef.SetRemoveByVisibilityOptions(kDerivedRemovePartsOnly, 2, False)
 
' Bauteile nach Größe
    Call oDerivedAssemblyDef.SetRemoveBySizeOptions(False)
    'Call oDerivedAssemblyDef.SetRemoveBySizeOptions(True, 2)

' Lochabdeckung
    Call oDerivedAssemblyDef.SetHolePatchingOptions(kDerivedPatchNone)
    'Call oDerivedAssemblyDef.SetHolePatchingOptions(kDerivedPatchRange, 0, 3)
 
' Skalierung
    'Call oDerivedAssemblyDef.ScaleFactor
' Spiegeln
    'Call oDerivedAssemblyDef.MirrorPlane=kDerivedPartMirrorPlaneXY
 
 
' Sonstiges
    oDerivedAssemblyDef.UseColorOverridesFromSource = False
    oDerivedAssemblyDef.ReducedMemoryMode = True
    oDerivedAssemblyDef.IndependentSolidsOnFailedBoolean = True
    oDerivedAssemblyDef.RemoveInternalVoids = True

' Create the shrinkwrap component
    Dim oDerivedAssembly As DerivedAssemblyComponent
    Set oDerivedAssembly = oPartDef.ReferenceComponents.DerivedAssemblyComponents.Add(oDerivedAssemblyDef)
    'oDerivedAssembly.BreakLinkToFile
 
 
' Set a reference to the active part document
    Dim oDoc2 As Inventor.PartDocument
    Set oDoc2 = oApp.ActiveDocument
 
' 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 "STEP Translater nicht aufrufbar."
        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
 

        oContext.Type = kFileBrowseIOMechanism

        Dim oData As DataMedium
        Set oData = ThisApplication.TransientObjects.CreateDataMedium

        oData.FileName = "G:\CAD Vereinfachungen\" & sPropValue & "_" & sPropValue1 & ".stp"
       
        On Error Resume Next
        Dim pSTR As String
        Dim strFile As String
        Dim sFileName As String
     
        pSTR = "G:\CAD Vereinfachungen\"
        strFile = Left(Mid(oData.FileName, InStrRev(oData.FileName, "\") + 1), 9) & "*" & ".stp"
        sFileName = Dir("G:\CAD Vereinfachungen" & "\" & sPropValue & "*.stp")
        Do While sFileName <> ""
            Kill "G:\CAD Vereinfachungen\" & sFileName
            sFileName = Dir
        Loop
       
        Kill Dir(pSTR & strFile)
        Err = 0
       
        Call oSTEPTranslator.SaveCopyAs(ThisApplication.ActiveDocument, oContext, oOptions, oData)
    End If
 
    Call oDoc2.Close(True)
     
    MsgBox "Die Vereinfachung wurde als Step und Sat Format unter -- G:\CAD Vereinfachungen -- gespeichert!!"
End Sub

---

Gruss

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

---

@Meierjo:

Warum hast du den Code von dir und rkaush kombiniert?
M.E. deckt der Code von rkaush doch alles ab und ist auch ein wenig leichter navollziehbar.

Grüße

EIBe 3D

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

---

Hallo Elbe 3D

Ja, hast recht, der Code von rkaush deckt alles ab.

EDIT:
Zuerst hatte der Code von rkaush nicht funktioniert, da habe ich ein wenig rumgepröbelt, und meinen Codeschnipsel dazugepflastert (ich gebe zu, ist nicht der schönste Code)
Und als es dann funktionierte, habe ich es so belassen

Habe erst zu spät gemerkt, dass der Code von rkaush nur nicht funktioniert, weil er einen Bindestrich anstelle Leerschlag im Ordner drin hatte, und somit natürlich keine Dateien gelöscht werden konnten

Gruss

[Diese Nachricht wurde von Meierjo am 02. Feb. 2021 editiert.]

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

---

Danke,

nun ists klar. Dachte schon ich hätte irgendwas übersehen.

Grüße

EIBe 3D

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

---

Guten Morgen zusammen,
vielen Dank an euch alle für die super Unterstützung - ich habe den Code noch so angepasst dass er sich nicht mehr aufhängt und nun macht er was er soll. Und gelernt habe ich auch wieder etwas - Dank dafür

Dim sFileName As String
sFileName = Dir("H:\TEST\" & sPropValue & "_" & "**.stp")

If Not sFileName = "" Then
    Kill "H:\TEST\" & sFileName
    Do While sFileName = ""
        sFileName = Dir
        Kill "H:\TEST\" & sFileName
    Loop
End If

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

BlueJay

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

---

ist da noch ein (kleiner?) Fehler in der Logik? Kann natürlich auch ein Denkfehler bei mir sein...

Angenommen es gibt nur einen Treffer bei Dir:
If ist True
Datei wird gelöscht
Do While ist True (weil sFileName unverändert)
sFileName wird "" (Aufruf von Dir)
Kill löscht ? (keine Ahnung, das Verzeichnis?)

Mein Vorschlag wäre also:

Code:

---

Dim sFileName As String
sFileName = Dir("H:\TEST\" & sPropValue & "_" & "**.stp")

    Do While sFileName <> ""  'Edit: korrigiert
       
        Kill "H:\TEST\" & sFileName
        sFileName = Dir
    Loop

---

[Edit: Fehler in der Zeile Do While korrigiert; gesehen von EIBe 3D (nächster Post) ]
------------------
Gruß KraBBy

[Diese Nachricht wurde von KraBBy am 03. Feb. 2021 editiert.]

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

---

@Krabby: Stimmt bei nur einem Treffer wird ein Fehler geworfen.

Bei dir passt es soweit bis auf:

Do While sFileName = ""

Besser:

Do While sFileName <> ""  

Korrigierter Code:

Code:

---

Dim sFileName As String
sFileName = Dir("D:\Test" & "\" & "222" & "*.txt")

Do While sFileName <> ""
    Kill "D:\Test\" & sFileName
    sFileName = Dir
Loop

---

Grüße

EIBe 3D

Edit: Sah gerade das Bluejay ein Post über dir den gleichen Fehler drin hat

[Diese Nachricht wurde von EIBe 3D am 03. Feb. 2021 editiert.]

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

---

Hallo

Deswegen habe ich vorher

Code:

---

on error resume next

---

und danach

Code:

---

err=0

---

eingebaut

Gruss

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

---

Nicht so gut unbekannte Fehler einfach zu verschlucken.

Weiter gehe ich davon aus, das du mit err = 0 dein vorher gesetztes "On Error Resume Next" wieder deaktivieren magst. Das geht über "On Error GoTo 0".

Mit err = 0 setzt du nur die err.Number wieder auf 0 zurück, dies macht man sinnigerweise über err.clear

Grüße

EIBe 3D

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