Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  SolidWorks
  Texte in Skizze auflösen

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS
  
CAD/CAM-Workshop in Suhl-Friedberg: SolidCAM + SOLIDWORKS
Autor Thema:  Texte in Skizze auflösen (1230 mal gelesen)
Hermann75
Mitglied
Konstrukteur


Sehen Sie sich das Profil von Hermann75 an!   Senden Sie eine Private Message an Hermann75  Schreiben Sie einen Gästebucheintrag für Hermann75

Beiträge: 124
Registriert: 04.05.2016

MS Windows 11 Pro; Intel Core i9-12900HX, 2.3GHz;
64GB Ram; 64bit; NVIDIA RTX A3000
SW 2021 SP5.1 Professional
SW-PDM 2021 Professional
HiCAD next 2008
Helios next 2008

erstellt am: 27. Sep. 2019 15:46    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo zusammen

Hat jemand ein Makro (oder Fragmente davon), mit dem man in einer offenen Skizze alle Texte auflösen kann (DissolveSketchText)? Und ist jemand bereit ein solches uns zur Verfügung zu stellen? Würde uns noch helfen.


Gruss, Hermann

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

freierfall
Ehrenmitglied V.I.P. h.c.
Techniker



Sehen Sie sich das Profil von freierfall an!   Senden Sie eine Private Message an freierfall  Schreiben Sie einen Gästebucheintrag für freierfall

Beiträge: 11547
Registriert: 30.04.2004

SWX (Pro) Flow 2020

erstellt am: 28. Sep. 2019 06:37    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Hermann75 10 Unities + Antwort hilfreich

ich mache das immer im AutoCad, vielleicht gibt es Text in Pfade umwandeln ja auch im DS. Theoretisch müsste es diese Funktion auch in kostenfreien Vektorenprogrammen geben, aber ich habe es nicht gefunden.

ich hoffe du meinst das.

herzlich Sascha

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

Hermann75
Mitglied
Konstrukteur


Sehen Sie sich das Profil von Hermann75 an!   Senden Sie eine Private Message an Hermann75  Schreiben Sie einen Gästebucheintrag für Hermann75

Beiträge: 124
Registriert: 04.05.2016

MS Windows 11 Pro; Intel Core i9-12900HX, 2.3GHz;
64GB Ram; 64bit; NVIDIA RTX A3000
SW 2021 SP5.1 Professional
SW-PDM 2021 Professional
HiCAD next 2008
Helios next 2008

erstellt am: 02. Okt. 2019 11:16    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


Skizze.txt

 
Hallo zusammen

Hab mal versucht einen Code zu schreiben. Leider funktioniert das Selektieren des Textes nur nicht immer. (Von 5 Texten wird nur einer gefunden.)

Hat jemand eine Idee, wie ich die Texte besser finden kann?


Sub Text_aufloesen()
'Makro zum Auflösen von Texten in Skizzen
'Hermann Stiefel für Zubler Handling AG, 01.10.2019
'
'Grosse Teile des Programms stammen von Stefan Berlitz und PaulchenPanter, www.cad.de

    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swSketch As SldWorks.Sketch
    Dim vSketchText As Variant
    Dim swSketchText As SldWorks.SketchText
    Dim ac As Long
    Dim boolstatus As Boolean
    Dim Coord As Variant
   
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swSketch = swModel.GetActiveSketch2
   
    vSketchText = swSketch.GetSketchTextSegments
   
    For ac = 0 To UBound(vSketchText)
        Set swSketchText = vSketchText(ac)
        Coord = swSketchText.GetCoordinates
        MsgBox (swSketchText.Text)
        boolstatus = swModel.Extension.SelectByID2("", "SKETCHTEXT", Coord(0), Coord(1), 0, False, 0, Nothing, 0)

        If boolstatus = 1 Then
            swModel.DissolveSketchText
        End If
       
        swModel.ClearSelection2 (True)

    Next

   
End Sub

Gruss, Hermann
PS: Beim angehängten File handelt es sich um einen sldprt-Datei mit der besagten Skizze

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

bk.sc
Ehrenmitglied V.I.P. h.c.
Konstrukteur Sondermaschinenbau



Sehen Sie sich das Profil von bk.sc an!   Senden Sie eine Private Message an bk.sc  Schreiben Sie einen Gästebucheintrag für bk.sc

Beiträge: 2776
Registriert: 18.07.2012

-Solid Works 2019 SP5
-Pro Engineer WF 3

erstellt am: 02. Okt. 2019 14:53    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Hermann75 10 Unities + Antwort hilfreich

Hallo Hermann,

ich würde mal tippen das die Coordinaten die GetCoordinates liefert nicht genau auf dem Text (einer Linie davon) liegen und daher bei SelectByID nicht erwischt werden, ich hab es jetzt mal versucht das SketchSegemt direkt zu selectieren (Select4) und es scheint zu klappen. Das Select/ Case kann man auch anderst lösen ist vom Ausgangsbeispiel noch drin (Get All Elements of Sketch Example (VBA)).

Code:

Option Explicit

Sub main()
    Dim sSkSegmentsName(5) As String
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
   
    Dim SelData As SldWorks.SelectData
   
    Dim swSketch As SldWorks.Sketch
    Dim vSkSegArr As Variant
    Dim vSkSeg As Variant
    Dim swSkSeg  As SldWorks.SketchSegment

    Dim boolstatus As Boolean
   
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

    Set swSketch = swModel.GetActiveSketch2

    vSkSegArr = swSketch.GetSketchSegments
   
    For Each vSkSeg In vSkSegArr
        Set swSkSeg = vSkSeg

        Select Case swSkSeg.GetType

            Case swSketchText
                boolstatus = swSkSeg.Select4(False, SelData)
       
                If boolstatus = True Then
                    swModel.DissolveSketchText
                End If
     
                swModel.ClearSelection2 (True)
       
            Case Default
           
        End Select
    Next vSkSeg
End Sub


Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

Hermann75
Mitglied
Konstrukteur


Sehen Sie sich das Profil von Hermann75 an!   Senden Sie eine Private Message an Hermann75  Schreiben Sie einen Gästebucheintrag für Hermann75

Beiträge: 124
Registriert: 04.05.2016

MS Windows 11 Pro; Intel Core i9-12900HX, 2.3GHz;
64GB Ram; 64bit; NVIDIA RTX A3000
SW 2021 SP5.1 Professional
SW-PDM 2021 Professional
HiCAD next 2008
Helios next 2008

erstellt am: 02. Okt. 2019 16:27    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Bernd

Das ist sehr lieb. Du hast vieles neu formuliert. Ja, das Makro kann jetzt das, was es können sollte. Vielen Dank! 


Gruss, Hermann

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2024 CAD.de | Impressum | Datenschutz