Guten Tag liebe Community
Ich habe bisher schon viele Probleme über die ich gestolpert bin mit den Beiträgen in diesem Forum lösen können. Doch leider finde ich zu meinem neuen Problem hier keine bereits bestehende Lösung.
Wir nutzen zum ablegen von Zeichnungen als DXF, PDF und STEP die Export- Makros aus der Makrotauschbörse. Diese hat mein Vorgänger angepasst, oder einfach aktiviert. Ich bin seit etwas mehr als einem Jahr in meinem jetzigen Betrieb. Wir benutzen neben SolidWorks 2016 das PDM Pro.File von ProCad, mit welchem wir unsere Informationen im Zeichnungskopf füllen. Dies wird wiederum von unserem ERP-System befüllt.
Die Makros funktionieren in den meisten Fällen einwandfrei. Allerdings werden in unserem ERP-System viele Artikel mit Sonderzeichen versehen z.B.: SK20/D14 oder 1.5". Dies sind die beiden, mit denen wir die meisten Probleme haben, denn sobald ein Sonderzeichen enthalten ist, macht das Makro gar nichts mehr. Unsere IT hat versucht mit hierbei unter die Arme zu greifen, da ich von Makro- Programmierung keine wirkliche Ahnung habe. Leider klappt dies mit dem VBS-Code nicht wie erhofft (also eigentlich gar nicht).
Daher stelle ich die Frage mal an euch, in der Hoffnung, dass ihr mir helfen könnt: Wie muss ich den angehängten Code (auch unten aufgeführt) abändern, dass dieser funktioniert?
Wenn ich mich nicht vollkommen Irre, habe ich den neuen Code für das ersetzen der Sonderzeichen fett markiert.
' ******************************************************************************
' Makro "Export in pdf dxf Jpg .swp" von Makrotauschbörse angepasst 26.08.11/ABu
' angepasst 15.10.13/ABu
' ******************************************************************************
Dim swApp As Object
Dim Part 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 saveFileName As String
Dim bRet As Boolean
Dim swDocEx As ModelDocExtension
Dim swPropMgr As CustomPropertyManager
Dim sProValue As String
Dim sProEvalValue As String
Dim sTimestamp As String
Dim sFileName As String
Sub main()
sTimestamp = Format(DateTime.Now, "yyyyMMdd", vbMonday, vbFirstJan1)
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set swDocEx = Part.Extension
Set swPropMgr = swDocEx.CustomPropertyManager("")
bRet = swPropMgr.Get3("Description", False, sProValue, sProEvalValue) 'Hier Feldnamen, welcher ausgelesen werden soll
sProEvalValue = System.Text.RegularExpressions.Regex.Replace(sProEvalValue, "[\.,!?\<>/;:]", "_")
' sProEvalValue = sProEvalValue.Replace("<", "_")
' sProEvalValue = sProEvalValue.Replace(">", "_")
' sProEvalValue = sProEvalValue.Replace(":", "_")
' sProEvalValue = sProEvalValue.Replace(";", "_")
' sProEvalValue = sProEvalValue.Replace("\", "_")
' sProEvalValue = sProEvalValue.Replace("/", "_")
' sProEvalValue = sProEvalValue.Replace("?", "_")
' sProEvalValue = sProEvalValue.Replace("'", "_")
' sProEvalValue = sProEvalValue.Replace("!", "_")
' sProEvalValue = sProEvalValue.Replace(",", "_")
sFileName = sTimestamp & " " & sProEvalValue
' MsgBox sFileName
swApp.ActiveDoc.ActiveView.FrameState = 1
swApp.ActiveDoc.ActiveView.FrameState = 1
Part.EditSketch
If (swApp.ActiveDoc.GetPathName = "") Then 'Abfrage ob Name vergeben wurde
MsgBox ("Bitte zuerst Zeichnung speichern!")
Exit Sub
End If
'dxf
'saveFileName = Left(swApp.ActiveDoc.GetPathName, Len(swApp.ActiveDoc.GetPathName) - Len(Part.GetTitle) + 2) + sFileName + ".dxf" ' Speichern als DXF-Datei im aktuellen Pfad
saveFileName = "c:\Step-Pdf\" + sFileName + ".dxf" ' Speichern als DXF-Datei im angegebenen Pfad
Part.SaveAs2 saveFileName, 0, True, False
'pdf
'saveFileName = Left(swApp.ActiveDoc.GetPathName, Len(swApp.ActiveDoc.GetPathName) - Len(Part.GetTitle) + 2) + sFileName + ".pdf" ' Speichern als PDF-Datei im aktuellen Pfad
'saveFileName = "c:\Step-Pdf\" + sFileName + ".pdf" ' Speichern als PDF-Datei im angegebenen Pfad
'Part.SaveAs2 saveFileName, 0, True, False
'jpg
'saveFileName = Left(swApp.ActiveDoc.GetPathName, Len(swApp.ActiveDoc.GetPathName) - Len(Part.GetTitle) + 2) + sFileName + ".jpg" ' Speichern als JPG-Datei im aktuellen Pfad
'saveFileName = "c:\temp\" + sFileName + ".jpg" ' Speichern als JPG-Datei im angegebenen Pfad
'Part.SaveAs2 saveFileName, 0, True, False
End Sub
Besten Dank & freundliche Grüsse aus der Schweiz
Eure Rexesta
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP