---

Hallo Forum!

Unter ADT 2005 kann man alle MTEXTe auswählen und dann mit mit "Auflösen" nach einfachen TEXT wandeln.
Wie kann man dies (das Auflösen) unter VBA nachbilden?
Habe schon alle möglichen Hilfen durchsucht, aber nichts gefunden.
Im Vorraus besten Dank.

mfG
Jürgen Rödel

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

---

Durch Erzeugung eines Textobjektes und nachfolgender Übertragung der Eigenschaften des MText-Objektes auf das Textobjekt sowie letztendlich Löschen des Ursprungs-Mtextobjektes.

------------------
- Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Habe dies schon mit folgendem Script versucht:
Public Sub ConvertMText()
Dim Object As Object
Dim AcDraw As AcadDocument
Dim OldMText As AcadMText
Dim NewText As AcadText
Dim CrLayer As AcadLayer

On Local Error Resume Next

'Verweis auf aktuelle Zeichnung speichern
Set AcDraw = ThisDrawing

'Layer entsperren
For Each CrLayer In ThisDrawing.Layers
    If CrLayer.Freeze = True Then
        CrLayer.Freeze = False
    End If
Next

'SelectionSets.Add "Auswahl"

' Objekte auswählen
Set AcSSet = SelectionSets("Auswahl")
AcSSet.Clear
'AcSSet.Select acSelectionSetAll

' Objekte durchsuchen
If AcSSet.Count > 0 Then
    For x = 0 To AcSSet.Count - 1
        Set Object = AcSSet.Item(x)
        If Object.ObjectName = "AcDbMText" Then
            Set OldMText = Object
           
            InsPoint = OldMText.InsertionPoint
            If TypeName(InsPoint) = "Double()" Then
                Angle = OldMText.Rotation
               
                tHeight = OldMText.Height
               
                sValue = OldMText.TextString
               
                If sValue <> "" Then
                    Set NewText = ModelSpace.AddText(sValue, InsPoint, tHeight)
                    NewText.Rotation = Angle
                    NewText.ObliqueAngle = Utility.AngleToReal("0.0", GetVariable("AUNITS"))
                    NewText.StyleName = OldMText.StyleName
                                       
                    Set pointObj = ThisDrawing.ModelSpace.AddPoint(InsPoint)
                    NewText.Alignment = OldMText.AttachmentPoint + 5
                    NewText.TextAlignmentPoint = InsPoint
                    NewText.Layer = OldMText.Layer
                    pointObj.Delete
                    OldMText.Delete
                End If
            End If
        End If
    Next
End If
       
End Sub

Funktioniert auch soweit, nur das ich bei MTEXTen mit mehrehren Zeilen  einiges an Müll in den Texten bekomme.

z.B. wird aus:

Hydrantenschrank
demontierbar

{\fSwis721 BT|b0|i0|c0|p34;Hydrantenschrank\Pdemontierbar}

Woher kommt dies?

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

---

Zitat:

---

Original erstellt von jroedel:
z.B. wird aus:

Hydrantenschrank
demontierbar

{\fSwis721 BT|b0|i0|c0|p34;Hydrantenschrank\Pdemontierbar}

Woher kommt dies?

---

Das sind Formatanweisungen
\f .. Schriftfont bis zum ;
\P .. Zeilenwechsel
.... da gibts noch Höhe, Farbe ...

------------------
- Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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