---

Hallo zusammen

Wir machen in unseren Zeichnungsdateien jeweils ein Blatt mit dem Namen "dxf" in welchem dann die Blechteile für den Laser nochmals abgebildet sind. Dieses Blatt speichern wir dann jeweils als dxf ab!

Ich bin auf der Suche nach einem Makro, welcher das Blatt namens "dxf" als dxf abspeichert... dann sollte sich ne "Speichern unter"-Maske direkt im Laserordner öffnen und ich bestimme dann in welches Projekt das dxf-File abgespeichert wird.

Kann mir jemand weiterhelfen??? Ich habe bloss das Makro von Stefan Berlitz gefunden... dieses speichert jedoch alle Blätter als dxf ab...etc.

' **********************************************************************
' * Makro erzeugt aus dem aktiven Zeichnungsdokument für alle Blätter
' * eine DXF Datei im Verzeichnis der Zeichnung. Es werden alle Blätter
' * unter dem Namen kombiniert mit dem Blattnamen abgespeichert.
' *
' * 05.04.2001 Stefan Berlitz (stefan.berlitz@solidworks.cad.de)
' * http://solidworks.cad.de
' * http://swtools.cad.de
' **********************************************************************

Dim SwApp As Object
Dim DrawingDoc As Object
Dim Sheet As Object

Dim Titel As String
Dim Datei As String
Dim temp As String
Dim pfad As String
Dim msgtxt As String

Dim i As Long
Dim AnzahlBl As Long
Dim SheetName As String

Const swDocDRAWING = 3

Sub main()

    Set SwApp = CreateObject("SldWorks.Application")
    Set DrawingDoc = SwApp.ActiveDoc

    If (DrawingDoc.GetType <> swDocDRAWING) Then
        ' wenn keine Zeichnung aktiv wird das Makro wieder beendet
        MsgBox "Nur für Zeichnungen geeignet"
        Exit Sub
    End If

    ' die Anzahl der Blätter holen, und dann in der Schleife eines nach
    ' dem anderen Abspeichern. Dazu ein Handle auf das aktuelle Blatt holen
    AnzahlBl = DrawingDoc.GetSheetCount
    Set Sheet = DrawingDoc.GetCurrentSheet

    ' damit die DXF anschließend im Verzeichnis der Zeichnung gespeichert werden
    ' muss der Pfad ermittelt werden. Ansonsten werden die DXFs im Verzeichnis
    ' des Makro gespeichert. Wenn man ein Sammelverzeichnis hat kann man das
    ' natürlich auch einfach direkt angeben
    temp = DrawingDoc.GetPathName
    ' da wir nur den Pfad brauchen alles andere abtrennen
    For i = Len(temp) To 1 Step -1
        If Mid$(temp, i, 1) = "\" Then
            pfad = Left(temp, i)
            Exit For
        End If
    Next i

    ' wenn mehr als ein Blatt da ist könnte es sein, dass wir nicht auf
    ' Blatt 1 sind. In einem Makro müssen wir jetzt einen Trick machen, um
    ' auf das erste Blatt zurückzukommen.
    ' Dazu immer wieder ein Blatt zurückspringen und dabei den Blattnamen
    ' vergleichen; wenn der gleich bleibt haben wir das erste Blatt erreicht.
    SheetName = Sheet.GetName
    For i = 1 To AnzahlBl - 1
        DrawingDoc.SheetPrevious
        Set Sheet = DrawingDoc.GetCurrentSheet
        If (SheetName = Sheet.GetName) Then
            Exit For
        End If
        SheetName = Sheet.GetName
    Next i

    ' jetzt sind wir garantiert auf dem ersten Blatt und können jetzt eins
    ' nach dem anderen Abspeichern
    msgtxt = ""

    For i = 1 To AnzahlBl

        ' nur den Dokumentnamen holen (der in der Titelzeile von SolidWorks
        ' angezeigt wird)
        Titel = DrawingDoc.GetTitle
        MsgBox DrawingDoc.GetPathName
        ' und die Endung mit dem .slddrw abschneiden, wenn vorhanden
        If (InStr(Titel, ".sld") > 0) Then
          Datei = Left(Titel, InStr(Titel, ".sld") - 1)
        Else
          Datei = Titel
        End If
        ' wir wollen alle Blätter als DXF mit den eingestellten Optionen abspeichern
        ' hier könnte auch z.B. einfach durch Umbenennen der Endung das Blatt als
        ' DWG (".dwg") oder TIFF (".tif") gespeichert werden. dabei werden aber
        ' jeweils die aktuellen Exportparameter benutzt, also würden z.B. alle
        ' TIFFs in derselben Größe abgespeichert.
        Datei = pfad & Datei & ".dxf"

        ' dann erfolgt das Speichern, die Parameter sind:
        ' DrawingDoc.SaveAs2 ( newName, unused, saveAsCopy, silent )
        ' wenn alles geklappt hat, wird eine 0 zurückgeliefert, ansonsten ein
        ' Wert ungleich 0
        If (DrawingDoc.SaveAs2(Datei, 0, True, False)) Then
            MsgBox "FEHLER BEIM SPEICHERN VON " & Datei & Chr$(10) & Chr$(13)
            msgtxt = msgtxt & "*** FEHLER bei: " & Datei & Chr$(10) & Chr$(13)
        Else
            msgtxt = msgtxt & "erfolgreich gespeichert: " & Datei & Chr$(10) & Chr$(13)
        End If

        ' und wenn noch Blätter kommen dieses aktivieren
        If AnzahlBl > i Then
            DrawingDoc.SheetNext
        End If
    Next i

    ' und noch die Zusammenfassung übers Speichern ausgeben
    MsgBox msgtxt
End Sub

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

---

Hallo, (leider kenne ich deinen Namen nicht)

Fast am Ende des Makros steht       

' und wenn noch Blätter kommen dieses aktivieren
        If AnzahlBl > i Then
            DrawingDoc.SheetNext
        End If

Mit Drawing.Doc.SheetNext springt man zu nächsten Blatt. In der Api Hilfe gibt es sicher
auch einen Befehl welcher auf ein Blatt mit einem bestimmten Namen springt.
Ansonsten kannst du die Logik von diesem Makro verwenden, und zusätzlich noch den Vergleich anstellen, ob der Name von aktuellen Blatt dem gewünschten entspricht, und nur dann wird exportiert.

Hab auch dieses Makro als Grundlage verwenden um einen TIFF, DXF, DWG  Export per Makro zu erstellen.

[Edit] Hier noch der Code dazu

Code:

---

Sub main()

    Set swApp = CreateObject("SldWorks.Application")
    Set DrawingDoc = swApp.ActiveDoc
DrawingDoc.ActivateSheet ("DXF-Blatt")

End Sub

---

[/Edit]

Gruss
Mike

------------------

     The Power Of Dreams

[Diese Nachricht wurde von Oberli Mike am 16. Okt. 2008 editiert.]

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