---

Guten Morgen zusammen,
habe mal eine kurze Frage - wie kann ich dem unten aufgeführten Programm beibringen das es die Datei immer auf dem Desktop ablegt?
Vielen Dank im voraus

MFG

Public Sub CreateDXF()
    On Error Resume Next
    If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then
        Exit Sub
    End If
 
    Dim oDoc As Inventor.DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    If oDoc.FullFileName = "" Then
        MsgBox "Bitte zuerst die Zeichnung speichern...  "
        Exit Sub
    End If
    oDoc.SaveAs Replace(oDoc.FullFileName, Right(oDoc.FullFileName, 3), "dxf"), True
 
    If Err.Number = 0 Then
        MsgBox "Die Datei:" & vbCrLf & vbCrLf & Replace(oDoc.FullFileName, Right(oDoc.FullFileName, 3), "dxf") & vbCrLf & vbCrLf & "wurde erfolgreich gespeichert"
    Else
        MsgBox "Fehler: " & Err.Description
    End If
End Sub

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

BlueJay

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

---

Hallo

Indem du oDoc.FullFileName (Dateiname inkl. vollständigem Pfad) durch den Pfad zu deinem Desktop + Dateiname + Endung ersetzt. Das Ganze ist ein String, der mit den üblichen Zerschnippel-, Ersetzungs- und Wiederzusammbaufunktionen von VB behandelt werden kann. Aus'n Kopf in etwa so:

Code:

---

Public Sub CreateDXF()
    On Error Resume Next
    If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then
        Exit Sub
    End If

    Dim oDoc As Inventor.DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    If oDoc.FullFileName = "" Then
        MsgBox "Bitte zuerst die Zeichnung speichern...  "
        Exit Sub
    End If
   
    ' Pfad entfernen
    Dim sName As String = oDoc.FullFileName.Substring(oDoc.FullFileName.LastIndexOf("\") + 1)
    ' Dateiendung ersetzen
    sName = Replace(sName, Right(sName, 3), "dxf")
    ' neuen Pfad hinzufügen
    sName = "C:\Dokumente und Einstellungen\$Benutzername$\Desktop\" & sname

    oDoc.SaveAs sname, True

    If Err.Number = 0 Then
        MsgBox "Die Datei:" & vbCrLf & vbCrLf & sName & vbCrLf & vbCrLf & "wurde erfolgreich gespeichert"
    Else
        MsgBox "Fehler: " & Err.Description
    End If
End Sub

---

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

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

---

Danke für die Antwort,

in dieser Zeile hängt sich das Programm leider auf?

Dim sName As String = oDoc.FullFileName.Substring(oDoc.FullFileName.LastIndexOf("\") + 1)

Vielen Dank noch mal

MFG

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

BlueJay

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

---

Hallo

Dann porobier mal:

Code:

---

Public Sub CreateDXF()
    On Error Resume Next
    If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then
        Exit Sub
    End If

    Dim oDoc As Inventor.DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    If oDoc.FullFileName = "" Then
        MsgBox "Bitte zuerst die Zeichnung speichern...  "
        Exit Sub
    End If
 
    Dim sName As String
    sName = "C:\Dokumente und Einstellungen\$Benutzername$\Desktop\" & Replace(oArray(UBound(Split(oDoc.FullFileName, "\"))), "idw", "dxf")

    oDoc.SaveAs sName, True

    If Err.Number = 0 Then
        MsgBox "Die Datei:" & vbCrLf & vbCrLf & sName & vbCrLf & vbCrLf & "wurde erfolgreich gespeichert"
    Else
        MsgBox "Fehler: " & Err.Description
    End If
End Sub

---

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

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

---

Danke, funkt aber leider immer noch nicht
Programm scheint mit dieser Zeile probleme zuhaben:

sName = "C:\Dokumente und Einstellungen\$Benutzername$\Desktop\" & Replace(oArray(UBound(Split(oDoc.FullFileName, "\"))), "idw", "dxf")

Danke noch mal

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

BlueJay

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

---

man BlueJay,

Du machst es Dir aber einfach!

Nur zu sagen: Es geht nicht, liefer mal ne funktionierende Lösung.
Mach Dir doch auch selber mal Gedanken. Der Ralf hilft ja schon eine ganze Menge.

Hier geht es doch lediglich darum, den Dateinamen zu bestimmen. Das wirst du doch hinkriegen.

------------------
Gruß Lothar Boekels

-----------------------------------------------------
Wir unterstützen die Arbeit der
- Rettungshundestaffel des DRK in Viersen
Das könnt Ihr auch tun.

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

---

Entschuldigung,
ich wollte hier niemand auf den Schlips treten, auch habe ich niemand aufgefordert mir eine fertige Lösung zu basteln! Um Unterstützung habe ich gefragt - villeicht um ein bischen viel - aber ich versuche mich in einem Gebiet in dem ich wenig Erfahrung mitbringe - Entschuldigung dafür!

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

BlueJay

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

---

Hallo

So, jetzt aber Gehirn an !!! 
Wofür könnte denn $BENUTZERNAME$ in der Zeile stehen? Vielleicht für deinen Windows-Benutzernamen, den ich unglaublicherweise nicht wissen kann und deswegen durch den üblichen Platzhalter ersetzt habe?

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

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

---

Zitat:

---

Original erstellt von Bluejay:

Public Sub CreateDXF()
    On Error Resume Next
    If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then
        Exit Sub
    End If
  
    Dim oDoc As Inventor.DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
    If oDoc.FullFileName = "" Then
        MsgBox "Bitte zuerst die Zeichnung speichern...   "
        Exit Sub
    End If
    oDoc.SaveAs Replace(oDoc.FullFileName, Right(oDoc.FullFileName, 3), "dxf"), True
  
    If Err.Number = 0 Then
        MsgBox "Die Datei:" & vbCrLf & vbCrLf & Replace(oDoc.FullFileName, Right(oDoc.FullFileName, 3), "dxf") & vbCrLf & vbCrLf & "wurde erfolgreich gespeichert"
    Else
        MsgBox "Fehler: " & Err.Description
    End If
End Sub

---

Hallo habe das oben zitierte Skript auf DWG-Abspeicherung (alle "dxf" mit "dwg" ersetzt, soweit das passt?) geändert. Unter INV 2012 hat dieses Skript super funktioniert. Aber seit dem ich INV 2014 nutze stürzt es manchmal direkt mit Inventor ab und manchmal läuft es durch.

Meine Frage:

Eventuell fehlt der Abspeicherfunktion manchmal die Konfigurations INI-Datei bzw. die abzuspeichernde Dateiversion. Kann man diese bzw den Ort der Export.ini als Option einfliesen lassen (da man bei Speichern unter ja auch optionen einstellen kann)? Speicherort der Ziel-DWG bleibt im selben wo die Quell-IDW sitzt.

Viele Grüße,

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

---

Hallo

Die SaveAs-Methode kennt die Möglichkeit nicht an den Optionen etwas zu ändern. Benutze dafür das Translator-AddIn von Inventor.
Tritt der Absturz nachvollziehbar auf oder stürzt er mal ab und das nächste Mal klappt's mit der selben Zeichnung? Seltsam ist es schon das jetzt plötzlich Fehler in dieser alten Funktion auftreten, aber Autodesk war schon immer für Überraschungen gut.

Code:

---

Public Sub PublishDWG()
    ' Get the DWG translator Add-In.
    Dim DWGAddIn As TranslatorAddIn
    Set DWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC2-122E-11D5-8E91-0010B541CD80}")

    'Set a reference to the active document (the document to be published).
    Dim oDocument As Document
    Set oDocument = ThisApplication.ActiveDocument

    Dim oContext As TranslationContext
    Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
    oContext.Type = kFileBrowseIOMechanism

    ' Create a NameValueMap object
    Dim oOptions As NameValueMap
    Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap

    ' Create a DataMedium object
    Dim oDataMedium As DataMedium
    Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

    ' Check whether the translator has 'SaveCopyAs' options
    If DWGAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then

        Dim strIniFile As String
        strIniFile = "C:\tempDWGOut.ini"
        ' Create the name-value that specifies the ini file to use.
        oOptions.Value("Export_Acad_IniFile") = strIniFile
    End If

    'Set the destination file name
    oDataMedium.FileName = "c:\tempdwgout.dwg"

    'Publish document.
    Call DWGAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub

---

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

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

---

Hi,

also die Abstürze treten sporadisch auf. Wenn ich eine idw (meistens Multisheet) nach dem Inventorstart öffne stürtzt Inventor meist sofort ab. Wenn ich vorher nochmal den VBA Editor öffne und da play drücke geht es dann wieder einmal ab und zu.

Ich werde mal dass Addin testen.

Ich sehe gerade das die Ziel.dwg unter c: gespeichert wird. Hauptsächlich benötige ich die Speicherung im Quellordner der IDW unter dem Quellnamen + Blattname.dwg (da Multisheets)?

Viele Grüße,

[Diese Nachricht wurde von EKW am 22. Aug. 2013 editiert.]

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