---

MakroDXF.txt

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

---

Hallo Rexesta,

willkommen im Forum 

Ich glaube der von Dir fett markierte Bereich könnte eine Funktion von .NET sein...

Wenn man diesen fett markierten Bereich durch

Code:

---

Dim sSonderzeichen As String
Dim sSonderz As String
Dim sErsatzposition As String
Dim sErsatzzeichen As String
Dim x, Sonderzlaenge As Integer

' Hier das Ersatzzeichen festlegen
sErsatzzeichen = "_"

' Es können noch beliebige Zeichen in den String eingefügt werden...
sSonderzeichen = "<>:;\/?'!,"

' Anzahl der Sonderzeichen ergeben Anzahl der Schleifenwiederholungen
Sonderzlaenge = Len(sSonderzeichen)

' Jetzt jedes Sonderzeichen im String suchen
For x = 1 To Sonderzlaenge
    ' Einzelnes Sonderzeichen aus der Zeichenkette sSonderzeichen herausholen
    sSonderz = Left(sSonderzeichen, x)
    sSonderz = Right(sSonderz, 1)
    ' Schleife wenn mehrere gleiche Sonderzeichen vorhanden sind
    While "0" <> InStr(1, sProEvalValue, sSonderz, 1)
        ' Position des Sonderzeichen herausfinden
        sErsatzposition = InStr(1, sProEvalValue, sSonderz, 1)
        ' Sonderzeichen gegen Ersatzzeichen tauschen
        Mid(sProEvalValue, sErsatzposition) = sErsatzzeichen
    Wend
Next x

---

ersetzt, funktioniert es mit VBA (zumindest bei mir  ).

HTH
Ralf

[19.12.2018 Nachtrag]
Die Replace-Funktion kann auch hier genutzt werden. Der Syntax war nur nicht richtig.

Statt: sProEvalValue = sProEvalValue.Replace("<", "_")
Dies: sProEvalValue = Replace(sProEvalValue, "<", "_")

[/Nachtrag]

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

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

---

Hallo Ralf Tide,

Ich habe den Code mit dem von Dir ersetzt und getestet. Er funktioniert, ob nun ein Einziges, oder mehrere Sonderzeichen im Text sind.
Besten Dank 

Noch eine weitere Frage diesbezüglich:
Gibt es die Möglichkeit die Zoll-Zeichen zu ersetzen, da diese ja eigentlich im VBA-Script selbst Verwendung finden?

Besten Dank & Grüsse
Rexesta

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

---

Hallo Rexesta,

einfach in der Zeile

Code:

---

' Es können noch beliebige Zeichen in den String eingefügt werden...
sSonderzeichen = "<>:;\/?'!,"

---

ein + Chr$(34) (ASCII) hinzufügen:

Code:

---

' Es können noch beliebige Zeichen in den String eingefügt werden...
sSonderzeichen = "<>:;\/?'!," + Chr$(34)

---

HTH
Ralf

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

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

---

Hallo Ralf,

Besten Dank für deine Hilfe, das funktioniert einwandfrei!   

Freundliche Grüsse aus der Schweiz,

Rexesta 

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

---

Hallo Rexesta,

Zitat:

---

Original erstellt von Rexesta:
Gibt es die Möglichkeit die Zoll-Zeichen zu ersetzen, da diese ja eigentlich im VBA-Script selbst Verwendung finden?

---

Ja, am einfachsten den gewünschten Character (also das ") an den String mit den Ersatzzeichen anhängen:

Code:

---

sSonderzeichen = "<>:;\/?'!," & Chr(34)

---

Das ist etwas einfacher zu lesen als das maskieren mit Mehrfachgänsefüsschen  

[Edit]Da war ich etwas arg langsam, die Hitze jetzt schon im Büro  [/edit]

Ciao,
Stefan

------------------
Inoffizielle deutsche SolidWorks Hilfeseite    http://solidworks.cad.de

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