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