Code:
Option ExplicitSub Text_Einfügen()
Dim DummyMText As AcadMText
Dim MText As AcadMText
Dim solid As AcadSolid
Dim varTxPkt As Variant
Dim TxPkt(0 To 2) As Double
Dim Richtung As Double
Dim Breite As Double
Dim Text As String
Dim TextHöhe As Double
Dim Verbreiterung As Double
' Boundingboxpunkte
Dim p1 As Variant
Dim p2 As Variant
' Solid Eckpunkte
Dim S1(0 To 2) As Double
Dim S2(0 To 2) As Double
Dim S3(0 To 2) As Double
Dim S4(0 To 2) As Double
' SolidZentrum
Dim Z(0 To 2) As Double
Richtung = 1
TextHöhe = 7.5
Text = "Das ist ein langer Text, oder ???\P" _
& "Eine zweite Zeile\Pund eine dritte Zeile hat er auch noch!\P\P" _
& "{\H0.6667x;Eine Leerzeile und eine Zeile mit kleiner Schrift\P" _
& "\H2.4x;und eine Große Schrift}\P" _
& "Und ein passendes Solid untendrunter!"
TxPkt(0) = 50
TxPkt(1) = 50
Set DummyMText = ThisDrawing.ModelSpace.AddMText(TxPkt, 0, Text)
DummyMText.AttachmentPoint = acAttachmentPointMiddleCenter
DummyMText.Height = TextHöhe
' Nochmals Einfügepunkt da verschoben nach Attachmentpoint
DummyMText.InsertionPoint = TxPkt
DummyMText.Update
' Eckpunkte holen
DummyMText.GetBoundingBox p1, p2
' Zugabe für Solid
Verbreiterung = TextHöhe * 0.15
' Solidpunkte
S1(0) = p1(0) - Verbreiterung: S1(1) = p1(1) - Verbreiterung
S2(0) = p1(0) - Verbreiterung: S2(1) = p2(1) + Verbreiterung
S3(0) = p2(0) + Verbreiterung: S3(1) = p1(1) - Verbreiterung
S4(0) = p2(0) + Verbreiterung: S4(1) = p2(1) + Verbreiterung
' Solid einzeichnen
Set solid = ThisDrawing.ModelSpace.AddSolid(S1, S2, S3, S4)
solid.Color = 255
solid.Update
' Drehpunkt Solid
Z(0) = TxPkt(0)
Z(1) = TxPkt(1)
' Solid drehen
solid.Rotate Z, Richtung
solid.Update
' Text kopieren
Set MText = DummyMText.Copy
MText.Width = (p2(0) - p1(0)) + Verbreiterung
MText.Rotation = Richtung
MText.Update
' Dummytext entfernen
DummyMText.Delete
End Sub