Moin liebes Forum,
ich habe da ein Problem mit meinem Makro. Wir erstellen immer wenn wir eine Zeichnung fertiggestellt haben eine Tiff, DXF und PDF Datei, wofür ich ein Makro erstellt habe. Nur muss man bisher immer für die Tiff Datei die Blattgrösse einstellen.
Ich habe versucht die benutzerdefinierte Seitengrösse auszulesen und zu verwenden, wie in diesem Thread: http://ww3.cad.de/foren/ubb/Forum2/HTML/001854.shtml#000000
...bin aber gescheitert.
Bekomme immer den Fehler: Laufzeitfehler 424 Objekt erforderlich und der Debug Modus verweist auf Zeile:
Set Sheet = DwgDoc.GetCurrentSheet ' Blatt auswählen
Da meine Makro Kenntnisse quasi kaum vorhanden sind, wäre super wenn man mir den Fehler zeigen könnte.
Das Makro hab ich in den Anhang gepackt, aber nochmal hier:
'Das Makro Speichert eine Tif, Dxf, Pdf Datei der Zeichnung in dem selben Ordner wie die Zeichnung.
Dim swApp As Object
Dim Part As Object
Dim Sheet As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Dim Wert As Integer
Dim saveFileName As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
swApp.ActiveDoc.ActiveView.FrameState = 1
swApp.ActiveDoc.ActiveView.FrameState = 1
Part.EditSketch
Set Sheet = DwgDoc.GetCurrentSheet ' Blatt auswählen
Blattgroesse = Sheet.GetProperties()
Blatthoehe = Blattgroesse(6) 'Hoehe aus dem Feld holen
Blattbreite = Blattgroesse(5) 'Breite aus dem Feld holen
ok = swApp.SetUserPreferenceDoubleValue(swTiffPrintPaperSize, swDwgPapersUserDefined) 'Blattgroesse auf Benutzerdef.
ok = swApp.SetUserPreferenceDoubleValue(swTiffPrintPaperWidth, Blattbreite) 'Breite setzen
ok = swApp.SetUserPreferenceDoubleValue(swTiffPrintPaperHeight, Blatthoehe) 'Hoehe setzen
If (swApp.ActiveDoc.GetPathName = "") Then 'Abfrage ob Name vergeben wurde
MsgBox ("Bitte zuerst Zeichnung speichern!")
Exit Sub
End If
Revision = Part.GetCustomInfoValue("", "Revision")
saveFileName = Left(swApp.ActiveDoc.GetPathName, Len(swApp.ActiveDoc.GetPathName) - 7) & "-R" & Revision & ".pdf" ' Speichern als PDF-Datei
Part.SaveAs2 saveFileName, 0, True, False
saveFileName = Left(swApp.ActiveDoc.GetPathName, Len(swApp.ActiveDoc.GetPathName) - 7) & "-R" & Revision & ".tif" ' Speichern als Tif-Datei
Part.SaveAs2 saveFileName, 0, True, False
saveFileName = Left(swApp.ActiveDoc.GetPathName, Len(swApp.ActiveDoc.GetPathName) - 7) & "-R" & Revision & ".dxf" ' Speichern als Dxf-Datei
Part.SaveAs2 saveFileName, 0, True, False
Set swApp = Application.SldWorks
End Sub
------------------
mfg Olli
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP