---

Hallo,

versuche gerade Im Inventor 2012, DWGs automatisch mit einem Button im aktuellen Projektordner abzuspeichern (eigentlich im Projektunterordner), dies funktioniert auch schon im aktuellen Projektordner. Mit der Funktion (oDoc.FullFileName) übergiebt er immer den ganzen Pfad z.B.: C:\Arbeitsbereich\Projekte\Bilten\ZNG-Nr.idw kann also nicht mehr in den DWG ordner im Verzeichnis wechseln.
Kann mir jemand helfen, das DWG-File in den Unterordner abzuspeichern?

Hier der Code den ich bis jetzt fabriziert habe:

Code:

---

Public Sub CreateDWG()
    On Error Resume Next
    If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then
        Exit Sub
    End If
 
  Dim Pfad As String
    Pfad = CurDir & "\"

    If Dir(Pfad & "\DWG", vbDirectory) = "DWG" Then 'erstellt den Ordner wenn es ihn noch nicht gibt
        'MsgBox "Ordner ''DWG'' ist vorhanden!"
        GoTo Sprung
    Else
        MkDir "DWG"
        MsgBox "Ordner ''DWG'' wurde in folgendem Pfad angelegt:  " & Pfad
    End If

Sprung:
 
    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), "DWG"), True
   
    If Err.Number = 0 Then
        MsgBox "Die Datei:" & vbCrLf & vbCrLf & Replace(oDoc.FullFileName, Right(oDoc.FullFileName, 3), "DWG") & vbCrLf & vbCrLf & "wurde erfolgreich gespeichert"
        FileSystemObject.CopyFile "oDoc.FullFileName", Pfad & "\DWG"
    Else
        MsgBox "Fehler: " & Err.Description
    End If
   
End Sub

---

Danke im Voraus für euere Hilfe!!!

------------------
Greets

Xaigon

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

---

Zitat:

---

Original erstellt von Xaigon:

Code:

---

    ...
    Pfad = CurDir & "\"

    If Dir(Pfad & "\DWG",
    ...

---

---

Hier bastelst Du Dir einen Pfad mit 2 hintereinander folgenden Backslash.

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

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

[Diese Nachricht wurde von lbcad am 18. Aug. 2012 editiert.]

[Diese Nachricht wurde von lbcad am 18. Aug. 2012 editiert.]

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

---

Hallo Lothar,

heisst dass, das ich ein Backslash weglassen kann?

Weisst du auch nicht wie ich das dwg.File in den Unterordner ablegen kann?

Gruss Xaigon

------------------
Greets

Xaigon

[Diese Nachricht wurde von Xaigon am 20. Aug. 2012 editiert.]

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

---

Hallo nochmals,

sollte sowas in der Art haben: nur das idw. kopieren und als dwg abspeichern:

Code:

---

Sub Verschieben()

FileCopy "C:\_LEB_Arbeitsbereich\Projekte\PRO-000374 Silos\KIBAG BILTEN\LEB-105851.idw", "C:\_LEB_Arbeitsbereich\Projekte\PRO-000374 Silos\KIBAG BILTEN\DWG\LEB-105851.idw"

End Sub

---

------------------
Greets

Xaigon

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

---

Hallo

Dann mußt du den Pfad halt zerlegen, den Unterordner einfügen und wieder zusammensetzen:

Code:

---

Private Sub namesplit()

Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument

Dim oFileName As String
oFileName = oDrawDoc.FullDocumentName

Dim oArray() As String
oArray = Split(oFileName, "\")

Dim sName As String
Dim i As Integer
sName = oArray(LBound(oArray))
For i = 1 To UBound(oArray) - 1
    sName = sName & "\" & oArray(i)
Next
sName = sName & "\dwg\" & Replace(oArray(UBound(oArray)), "idw", "dwg")

End Sub

---

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

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

---

Hallo Ralf,

danke für deinen schnellen Tip, aber kannst du mir mal den code erklären hab noch nie mit arrays gearbeitet!

Danke

------------------
Greets

Xaigon

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

---

Hallo

Was ein Array ist weißt du aber?
Im Groben:

Code:

---

Split(oFileName, "\")

---

Zerlegt einen String anhand des Trennzeichens "\" in einzelne Strings, das Trennzeichen selbst geht dabei verloren und füllt ein Array mit den Schnipseln. Das Array ist indiziert und schaut so aus:

[0],[C:]
[1],[Verzeichnis1]
[2],[Verzeichnis2]
[3],[Verzeichnis3]
[4],[Verzeichnis4]
usw.

Code:

---

sName = oArray(LBound(oArray))

---

gibt die untere Grenze (LowerBound) des Arrays als Index (im obigen Beispiel "0") zurück. Man könnte auch direkt mit

Code:

---

oArray(0)

---

auf die erste Zeile zugreifen. Die Zählung von Arrays kann aber auch bei 1, statt 0 beginnen, daher ist diese Variante sicherer.
sName hat jetzt den Inhalt "C:". Hab ich nur aus den folgenden Schleife heraus genommen, da dort nach dem ersten Durchlauf sName den Wert "\C:" hätte.

Code:

---

For i = 1 To UBound(oArray) - 1
    sName = sName & "\" & oArray(i)
Next

---

Ein schönes Beispiel für inkonsequente Programmierung. Was hab ich oben zum Thema Arrayindizierung gesagt? Genau, kann auch bei 1 beginnen. Also müßte doch der Schnipsel eigentlich heißen:

Code:

---

For i = LBound(oArray) + 1 To UBound(oArray) - 1
    sName = sName & "\" & oArray(i)
Next

---

Naja, sind wir mal nicht so. Die Schleife holt nur der Reihe nach die einzelnen Segmente aus dem Array und setzt sie wieder zu einem String zusammen. Den letzten Teil (er enthält den Dateinamen mit Endung) lassen wir erstmal weg.

Code:

---

sName = sName & "\dwg\" & Replace(oArray(UBound(oArray)), "idw", "dwg")

---

An den Pfad in sName hängen wir per Verkettung einfach das gewünschte Unterverzeichnis "\dwg\" dran. Den zweiten Teil muss man sich gedanklich von innen nach außen in Teilaufgaben zerlegen.

Code:

---

oArray(UBound(oArray))

---

... holt den Dateinamen samt Endung aus dem letzten Index des Arrays

Code:

---

Replace(oArray(UBound(oArray)), "idw", "dwg")

---

... ersetzt in dem String, den die innere Funktion liefert, die Zeichenkette "idw" durch "dwg".

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

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

---

Vielen Dank, nun funktioniert es einwandfrei!!

------------------
Greets

Xaigon

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