|
SolidWorks MakroMania ist eine Beispielsammlung einiger Makros, die Ihnen eine Vorstellung davon geben soll, was man auch schon mit Makros in SolidWorks alles anstellen kann. Der Code des Makros sollte so gut dokumentiert sein, dass Sie damit ohne weitere Anleitung verstehen, was gemacht wird. |
< voriges |
MakroMania Übersicht |
Nummer 05 DXF speichern alle Blätter |
|
Ich übernehme keine Haftung für die korrekte Funktion der Routinen oder irgendwelcher Schäden bei der Anwendung dieser Beispiele. Das gesamte Risiko trägt der Benutzer selbst. - Sorry, muss sein.
Es ist ziemlich lästig, wenn mehrblättrige Zeichnungen als DXF oder DWG abgespeichert werden sollen, da jedes Blatte einzeln aktiviert und dann abgespeichert werden muss, da kommen schnell ein paar Dutzend Mausklicks zusammen.
Hier folgt nun ein Beispiel, wie so etwas auch automatisiert werden kann; wenn da einige umständliche Mechanismen drin sind liegt es daran, dass ich es so geschrieben habe, dass es auch noch auf dem "alten" VB3-System von vor SolidWorks 2001 laufen soll.
' **********************************************************************
' * 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
| Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Donnerstag, 01. Februar 2007 17:40 |