Hot News aus dem CAD.de-Newsletter:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  
  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
Autor Thema:   Texte in Skizze auflösen (311 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: 64
Registriert: 04.05.2016

MS Windows 10 Pro; ASUS CPU E5-1620 v4 3.5GHz;
32GB Ram; 64bit; NVIDIA Quadro K2200;<P>SW 2017 SP3 Professional
SW-PDM 2017 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.
selbstst. techn. Zeichner



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: 10257
Registriert: 30.04.2004

SWX (Pro) Flow 2019

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: 64
Registriert: 04.05.2016

MS Windows 10 Pro; ASUS CPU E5-1620 v4 3.5GHz;
32GB Ram; 64bit; NVIDIA Quadro K2200;<P>SW 2017 SP3 Professional
SW-PDM 2017 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: 2236
Registriert: 18.07.2012

-Solid Works 2019 SP3
-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: 64
Registriert: 04.05.2016

MS Windows 10 Pro; ASUS CPU E5-1620 v4 3.5GHz;
32GB Ram; 64bit; NVIDIA Quadro K2200;<P>SW 2017 SP3 Professional
SW-PDM 2017 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)2019 CAD.de | Impressum | Datenschutz