---

Hallo,
wir haben mal eine kostenpflichtige Schriftart eingeführt, die uns mittlerweile ziemlich oft Probleme bereitet.
Offiziell wird diese auch nicht mehr im Unternehmen für Neuteile verwendet. Aus den SW-Vorlagen ist diese verschwunden, die Entwurfsnorm ist auch angepasst und wird bei jedem Speichern per Makro aktualisiert.
Leider werden (verständlicherweise) alle Texte auf alten Zeichnungen, bei denen der Haken "Schriftart des Dokuments" deaktiviert ist, durch diese Aktionen nicht in ihrer Schriftart geändert.
Hat jemand ein Makro, das ich auf einer Zeichnung alle Schriftarten durchsucht und austauscht, wenn es sich z.B. um die unerwünschte Schriftart "Frutiger" handelt?
Habe diverse Teillösungen im Forum gefunden, aber noch keine, die mir wirklich hilft.
Gruß
Stefan

------------------
Stefan

CSWP 2006

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

---

Hallo Stefan,

also doch im SolidWorks, hatte gestern schon eine Antwort geschrieben und zum Schluss erst gemerkt, dass dein voriger Beitrag im Draftsight-Brett war - und hab ihn da wieder gelöscht  

Also diesmal dann nur die Kurzvariante: schau dir mal in der API Hilfe die Beispiele Get Annotations Arrays Example (VBA) und Change Text Format Example (VBA) an, dass müsste recht nahe an dem sein, was du brauchst.

Ciao,
Stefan

PS: das mit diesen tollen Designerfonts, ohne die man überhaupt nicht leben kann und die entscheidend für die Auftragsvergabe ist, kenne ich auch. Bisher konnten wir uns allerdings immer erfolgreich dagegen wehren. Auch wenn z.B. der Unterschied zwischen Helvetica und Helvetica neue derart gravierend ist, dass es zwingend erscheint, für mehrere Tausend Firmenrechner diesen neuen Fonts zu kaufen, damit die Powerpointvorlagen auch stimmen, konnten wir bisher vermeiden, unsere Zeichnungen auch immer entsprechend anzupassen  

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

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

---

Hallo,

werde mir die API-Hilfe mal zu Gemüte führen. Ich hoffe, damit klar zu kommen.
Wenn ich was habe, stelle ich es hier zur Verfügung.

PS: Hatte mich gestern schon gewundert: Laut Email habe ich eine Antwort erhalten gehabt, jedoch im Forum war keine zu sehen....

------------------
Stefan

CSWP 2006

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

---

Hallo, habe folgendes probiert, bekomme aber imme rwieder Fehlermeldung "Objektvariable nicht festgelegt".
Stehe im Debugmodus bei "Set swAnn..."

Sub main()
Debug.Print "--------------------------------------------------"
'Set swApp = CreateObject("SldWorks.Application")

Dim i                          As Long
Dim swTextFormat                As SldWorks.TextFormat
Dim bRet                        As Boolean
Dim swApp                      As SldWorks.SldWorks
Dim swModel                    As SldWorks.ModelDoc2
Dim swSelMgr                    As SldWorks.SelectionMgr
Dim swAnnObj                    As Object
Dim swAnn                      As SldWorks.Annotation

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swAnnObj = swSelMgr.GetSelectedObject5(1)
Set swAnn = swAnnObj.GetAnnotation: Debug.Assert Not Nothing Is swAnn

If swModel Is Nothing Then
    MsgBox "Kein Dokument geöffnet"
    End
End If
If (swModel.GetType <> swDocDRAWING) Then
    MsgBox "Keine Zeichnung geöffnet"
    End
End If

Viewname = "2"
swModel.ClearSelection2 True
'Erste View suchen
Set swView = swModel.GetFirstView
Do While Not swView Is Nothing
    Viewname = swView.GetName2
    Numbers = swView.GetAnnotationCount
    Debug.Print Viewname + " - Annotations found: " + Str(Numbers)
   
    If Numbers > 0 Then
            'Change Font
            For i = 0 To Numbers
            'Set swAnn = swAnnObj.GetAnnotation
            Set swTextFormat = swAnn.GetTextFormat(i)
            If swTextFormat Like "*Frutiger*" Then
                swTextFormat.TypeFaceName = "Arial"
                bRet = swAnn.SetTextFormat(i, False, swTextFormat): Debug.Assert bRet
            End If
    Next

    End If
    Set swView = swView.GetNextView
Loop

End Sub

Ich verzweifle...

------------------
Stefan

CSWP 2006

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

---

Hallo Stefan,

Zitat:

---

Original erstellt von StefanNie:
Hallo, habe folgendes probiert, bekomme aber imme rwieder Fehlermeldung "Objektvariable nicht festgelegt".
Stehe im Debugmodus bei "Set swAnn..."

---

Ich vermute du meinst am Anfang des Makros die Zeile:

Code:

---

Set swAnnObj = swSelMgr.GetSelectedObject5(1)
Set swAnn = swAnnObj.GetAnnotation: Debug.Assert Not Nothing Is swAnn

---

Ich vermute, du hast vorher keine Beschriftung in der Zeichnung selektiert, aber genau das fragst du ja ab. Makros tun genau das, was du sagst, sind zuverlässig und strohdoof. Also: vorher eine Bemaßung selektieren und du kommst ein Stück weiter.

Aber nur ein Stückchen: in deiner Schleife unten hast du dann die Zeilen:

Code:

---

            Set swTextFormat = swAnn.GetTextFormat(i)
            If swTextFormat Like "*Frutiger*" Then                swTextFormat.TypeFaceName = "Arial"
                bRet = swAnn.SetTextFormat(i, False, swTextFormat): Debug.Assert bRet
            End If

---

In der fett markierten Zeile wird es das nächste mal rappeln, du holst dir zwar das TextFormat-Objekt, aber du musst das swTextFormat.TypeFaceName vergleichen.

Und von deiner Programmlogik her läuft auch noch was schief, du holst dir ganz am Anfang einmal die  selektierte Beschriftung (hoffentlich), um dann in einer Schleife für alle gefundenen Text immer wieder dieses eine Objekt (swAnn) anzusprechen. Du möchtest aber vermutlich was anderes erreichen.

Schau mal in der API Hilfe in das Beispiel Get All Notes Example in Drawing Template (VBA)
, da ist eine Traverse über alle Beschriftungen (notes) in einer Zeichnung drin.

Das ganze könnte dann so aussehen:

Code:

---

Sub main()
   
    Dim swApp                      As SldWorks.SldWorks
    Dim swModel                    As SldWorks.ModelDoc2
    Dim swView                    As SldWorks.View
    Dim swAnn                      As SldWorks.Annotation
    Dim swNote                    As SldWorks.Note
    Dim swTextFormat              As SldWorks.TextFormat
    Dim bRet                      As Boolean

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
   
    If swModel Is Nothing Then
        MsgBox "Kein Dokument geöffnet"
        End
    End If
    If (swModel.GetType <> swDocDRAWING) Then
        MsgBox "Keine Zeichnung geöffnet"
        End
    End If
   
    ' Startpunkt suchen, erste Beschriftung in der ersten View (Blatt)
    Set swView = swModel.GetFirstView
    Set swNote = swView.GetFirstNote

    Do While Not swNote Is Nothing

        Set swAnn = swNote.GetAnnotation
        bRet = swAnn.Select2(True, 0)

        Set swTextFormat = swAnn.GetTextFormat(i)
        Debug.Print swTextFormat.TypeFaceName
        If Not swTextFormat.TypeFaceName Like "*Arial*" Then
            swTextFormat.TypeFaceName = "Arial"
            bRet = swAnn.SetTextFormat(i, False, swTextFormat): Debug.Assert bRet
        End If
       
        Set swNote = swNote.GetNext
    Loop

End Sub

---

Ciao,
Stefan

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

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

---

Super. Vielen Dank. Klasse.
Makro Funktioniert.
Habe nur noch ergänzt, das es auch Beschriftungen ändern soll, die zur Zeichenansicht gehören (zusätzliche loop-Schleife).
Vorher änderte das Makro nur die Beschriftungen des Blattformates.
Werde es den Usern als Makro zur Verfügung stellen.

Sub main()
   
    Dim swApp                      As SldWorks.SldWorks
    Dim swModel                    As SldWorks.ModelDoc2
    Dim swView                    As SldWorks.View
    Dim swAnn                      As SldWorks.Annotation
    Dim swNote                    As SldWorks.Note
    Dim swTextFormat              As SldWorks.TextFormat
    Dim bRet                      As Boolean
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
   
    If swModel Is Nothing Then
        MsgBox "Kein Dokument geöffnet"
        End
    End If
    If (swModel.GetType <> swDocDRAWING) Then
        MsgBox "Keine Zeichnung geöffnet"
        End
    End If
   
    ' Startpunkt suchen, erste Beschriftung in der ersten View (Blatt)
    Set swView = swModel.GetFirstView
    Set swNote = swView.GetFirstNote
    Do While Not swView Is Nothing
        Do While Not swNote Is Nothing
        viewname = swView.GetName2  '02.07.2013
        annnr = swView.GetAnnotationCount  '02.07.2013
        'Debug.Print viewname + "- Texte:" + Str(annr)  '02.07.2013
            Set swAnn = swNote.GetAnnotation
            bRet = swAnn.Select2(True, 0)
   
            Set swTextFormat = swAnn.GetTextFormat(i)
            Debug.Print swTextFormat.TypeFaceName
            If swTextFormat.TypeFaceName Like "*Frutiger*" Then
                swTextFormat.TypeFaceName = "Arial"
                bRet = swAnn.SetTextFormat(i, False, swTextFormat): Debug.Assert bRet
                c = c + 1
            End If
            swModel.ClearSelection2 True
            Set swNote = swNote.GetNext
        Loop
    Set swView = swView.GetNextView    '02.07.2013
    If Not swView Is Nothing Then Set swNote = swView.GetFirstNote

    Loop
    If c > 0 Then
        MsgBox "Die Schriftart Frutiger wurde im vorliegenden Dokument " & c & " mal durch Arial ersetzt." & vbCrLf & "Bitte unbedingt Positionen und Hinweislinien kontrollieren!"
    End If
End Sub

------------------
Stefan

CSWP 2006

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