---

Hallo zusammen,

ich habe ein kleines Problem mit einem Makro.

Das Makro soll die Zeichnung als pdf drucken. Das funktioniert und ist hier aus dem Forum.
Nun soll es aber außer dem Dateinamen auch noch die Beschreibung bzw. description und das Datum des Drucks enthalten.

Mit dem was hier drunter steht funktioniert es wunderbar das die pdf Datei den Dateinamen und das Datum enthält
aber ich weiß nicht wie ich die description hinzufügen kann?

Leider bin ich mit Makros nicht vertraut und habe es gerade noch geschafft das Datum einzufügen.

Ich hoffe mir kann jemand helfen.

Dim swApp As Object
Dim Part As Object
Dim SelMgr As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As Object
Dim Dateiname
Sub main()

Set swApp = Application.SldWorks
' swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swDxfOutputNoScale, True

Set Part = swApp.ActiveDoc
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, swDxfFormat_e.swDxfFormat_R14)
Set SelMgr = Part.SelectionManager

If (Part.GetType <> swDocDRAWING) Then  ' Make sure the file is a Drawing
    swApp.SendMsgToUser2 "PDF und DXF Export funktioniert nur bei Zeichnungen!", swMbWarning, swMbOk
    Exit Sub  ' This is not a Drawing so exit
End If

swApp.SetUserPreferenceToggle 26, 1
Part.ClearSelection2 True
Dateiname = "c:\sw-export\" & Part.GetTitle + " " & Date & ".pdf"
Part.Extension.SaveAs Dateiname, 0, 0, Nothing, longstatus, longwarnings
swApp.SetUserPreferenceToggle 26, 1
Part.SheetPrevious
Dateiname = "c:\sw-export\" & Part.GetTitle + " " & Date & ".dwg"
Part.Extension.SaveAs Dateiname, 0, 0, Nothing, longstatus, longwarnings
Part.SheetPrevious
Dateiname = "c:\sw-export\" & Part.GetTitle + " " & Date & ".dxf"
Part.Extension.SaveAs Dateiname, 0, 0, Nothing, longstatus, longwarnings
End Sub

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

---

Hallo boney

versuch mal
----------------------------------------------------------
Set instance = swPart.Extension 
nnn = swApp.GetActiveConfigurationName(swPart.GetTitle)
Set value = instance.CustomPropertyManager(nnn)
value.Get2 "Benennung", wert1, wert2
----------------------------------------------------------
schau Dir dazu auch mal die Online Hilfe zu "GetActiveConfigurationName" und "Get2" an

------------------
Grüße
Heinz

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

---

Hallo nahe,

Herzlichen Dank für Deine Antwort.

Kannst Du mir vielleicht auch sagen wo ich das in dem Makro einfügen muss?

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

---

Probiers mal damit:

Code:

---

Dim swApp As Object
Dim Part As Object
Dim SelMgr As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As Object
Dim Dateiname As String
Dim Description As String

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, swDxfFormat_e.swDxfFormat_R14)
Set SelMgr = Part.SelectionManager

If (Part.GetType <> swDocDRAWING) Then  ' Make sure the file is a Drawing
    swApp.SendMsgToUser2 "PDF und DXF Export funktioniert nur bei Zeichnungen!", swMbWarning, swMbOk
    Exit Sub  ' This is not a Drawing so exit
End If

swApp.SetUserPreferenceToggle 26, 1

Description = Part.custominfo("Description")

Dateiname = "c:\sw-export\" & Part.GetTitle
If Description <> "" Then
    Dateiname = Dateiname & "_" & Description
End If
Dateiname = Dateiname & " " & Date
   

Part.Extension.SaveAs Dateiname & ".pdf", 0, 0, Nothing, longstatus, longwarnings

'swApp.SetUserPreferenceToggle 26, 1

'Part.SheetPrevious
Part.Extension.SaveAs Dateiname & ".dwg", 0, 0, Nothing, longstatus, longwarnings
'Part.SheetPrevious
Part.Extension.SaveAs Dateiname & ".dxf", 0, 0, Nothing, longstatus, longwarnings
End Sub

---

Ein paar Anmerkungen:

• Bitte richtig ausdrücken. Du "druckst" die Zeichnung nicht als PDF, sondern du speicherst sie als PDF.
  Unter "Drucken" als PDF verstehe ich, wenn du das PDF über ein Zusatztool wie z.B. PDFCreator erstellst, das sich als Druckertreiber installiert und wie ein Drucker angesprochen wird.
  Ich sage das deshalb, da die vorgehensweise beim Programmieren hier sehr viel komplizierter wäre.
  
• Bitte gleich "anständige" Variablendeklaration angewöhnen.
  Also nicht "Dim Dateiname" sondern "Dim Dateiname as String". VB freut sich, wenn es von Beginn an weiß, mit was es zu tun bekommt.
  
• swApp.SetUserPreferenceToggle 26, 1 setzt irgendeine Systemoption, ich weiß jetzt nicht, welche. Das muss aber nicht mehrmals aufgerufen werden, drum habe ich das beim 2. Mal auskommentiert.
  
• Strings solltest du mit & verknüpfen, nicht mir +.
  
• Ich fülle die Variable Dateinamen nur noch 1x, nicht 3x wie du. Die Dateierweiterung gebe ich dann erst beim Speichernbefehl dazu. Das macht das ganze pfelgeleichter, wenn z.B. der Aufbau des Dateinamens mal geändert werden soll.
  
• Brauchst du "Part.SheetPrevious" wirklch vor jedem Speichern? Das macht nur Sinn, wenn du mehrblättrige Zeichnungen hast und jedes Blatt in einem anderen Format gespeichert haben willst.
  Ich habs mal auskommentiert. Wenn du das brauchts, musst du das halt wieder aktivieren.

Das sind so Kleinigkeiten ... 

------------------
Klaus

www.al-ko.com | mein Gästebuch

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

---

Super geil. Perfekt danke. ÜÜÜÜÜÜÜÜÜÜ

So hab ich es mir gewünscht.

Vielen vielen Dank.

Deine Anmerkungen versuche ich zu beherzigen.
Muss aber dazu sagen das ich dieses Makro nur mit dem + Date erweitert habe. Der Rest war schon da. Vermutlich hier aus dem Forum.

Mal angenommen ich wollte den Namen der Solidworks Zeichnung,

die heißt ja immer "12345 - Blatt1"

als pdf gespeichert jetzt  "12345 - Blatt1 Beschreibung date"

auf

"12345 Beschreibung date" Verkürzen. Sprich ohne das Blatt1. Wie würde ich das machen.

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

---

Ups, glatt übersehen, aber du hast recht.

Der Vollständigkeit halber, und weils beim Programmieren hilft, wenn VB weiß, mit was es zu tun hat,
die ersten beiden Zeilen so ändern (ändert noch nix an der Funktion)
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2

Dann bei den Deklarationen noch
Dim DateiPfad As String
hinzufügen.

Ersetze die Zeile
Dateiname = "c:\sw-export\" & Part.GetTitle

Durch
DateiPfad = Part.GetPathName
Dateiname = "c:\sw-export\" & Replace(UCase(Mid(DateiPfad, InStrRev(DateiPfad, "\") + 1, Len(DateiPfad))), ".SLDDRW", "")

------------------
Klaus

www.al-ko.com | mein Gästebuch

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

---

Super geil.

Herzlichen Dank. Absolut perfekt.

Leider kann ich Dir nicht mehr als 10Üs geben irgendwie.

Für alle stelle ich dann mal das makro hier rein falls es jemand braucht.

Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim SelMgr As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As Object
Dim DateiPfad As String
Dim Dateiname As String
Dim Description As String

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
boolstatus = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swDxfVersion, swDxfFormat_e.swDxfFormat_R14)
Set SelMgr = Part.SelectionManager

If (Part.GetType <> swDocDRAWING) Then  ' Make sure the file is a Drawing
    swApp.SendMsgToUser2 "PDF und DXF Export funktioniert nur bei Zeichnungen!", swMbWarning, swMbOk
    Exit Sub  ' This is not a Drawing so exit
End If

swApp.SetUserPreferenceToggle 26, 1

Description = Part.CustomInfo("Description")

DateiPfad = Part.GetPathName
Dateiname = "c:\sw-export\" & Replace(UCase(Mid(DateiPfad, InStrRev(DateiPfad, "\") + 1, Len(DateiPfad))), ".SLDDRW", "")
If Description <> "" Then
    Dateiname = Dateiname & "-" & Description
End If
Dateiname = Dateiname & " " & Date
 

Part.Extension.SaveAs Dateiname & ".pdf", 0, 0, Nothing, longstatus, longwarnings

'swApp.SetUserPreferenceToggle 26, 1

'Part.SheetPrevious
Part.Extension.SaveAs Dateiname & ".dwg", 0, 0, Nothing, longstatus, longwarnings
'Part.SheetPrevious
Part.Extension.SaveAs Dateiname & ".dxf", 0, 0, Nothing, longstatus, longwarnings
End Sub

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