| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS | | | | Optimieren Sie Ihre SOLIDWORKS Tasks mit Visiativ myCADtools - Jetzt Kostenlos testen >>, eine Pressemitteilung
|
Autor
|
Thema: Makro zum Schriftart ersetzen in Zeichnungen (2681 mal gelesen)
|
StefanNie Mitglied Konstrukteur und CAD-Administrator
Beiträge: 75 Registriert: 07.03.2005 SW2023 SP5.0 mit DBWorks R23
|
erstellt am: 26. Jun. 2013 07:56 <-- editieren / zitieren --> Unities abgeben:
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 |
StefanBerlitz Guter-Geist-Moderator IT Admin (CAx)
Beiträge: 8756 Registriert: 02.03.2000 SunZu sagt: Analysiere die Vorteile, die du aus meinem Ratschlag ziehst. Dann gliedere deine Kräfte entsprechend und mache dir außergewöhnliche Taktiken zunutze.
|
erstellt am: 26. Jun. 2013 08:27 <-- editieren / zitieren --> Unities abgeben: Nur für StefanNie
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 |
StefanNie Mitglied Konstrukteur und CAD-Administrator
Beiträge: 75 Registriert: 07.03.2005 SW2023 SP5.0 mit DBWorks R23
|
erstellt am: 26. Jun. 2013 08:38 <-- editieren / zitieren --> Unities abgeben:
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 |
StefanNie Mitglied Konstrukteur und CAD-Administrator
Beiträge: 75 Registriert: 07.03.2005 SW2023 SP5.0 mit DBWorks R23
|
erstellt am: 01. Jul. 2013 16:47 <-- editieren / zitieren --> Unities abgeben:
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 |
StefanBerlitz Guter-Geist-Moderator IT Admin (CAx)
Beiträge: 8756 Registriert: 02.03.2000 SunZu sagt: Analysiere die Vorteile, die du aus meinem Ratschlag ziehst. Dann gliedere deine Kräfte entsprechend und mache dir außergewöhnliche Taktiken zunutze.
|
erstellt am: 02. Jul. 2013 08:27 <-- editieren / zitieren --> Unities abgeben: Nur für StefanNie
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 |
StefanNie Mitglied Konstrukteur und CAD-Administrator
Beiträge: 75 Registriert: 07.03.2005 SW2023 SP5.0 mit DBWorks R23
|
erstellt am: 02. Jul. 2013 16:49 <-- editieren / zitieren --> Unities abgeben:
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 |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|