[求助]：获得MTEXT文字的最外围范围

liuchang.555

如何获得MTEXT文字的最外围范围?

雪山飞狐(lzh)

先把它炸开

qiaqiadeng

然后如此这般：
Public Sub Box()
Dim Sela As AcadSelectionSet
Dim i As Integer
Dim Num As Integer
Dim Obj As AcadEntity
Dim MinPoint As Variant, MaxPoint As Variant
Dim MinP(0 To 2) As Double, MaxP(0 To 2) As Double
Dim P1(0 To 11) As Double
Dim LL As AcadPolyline
Dim InPoint As AcadPoint
Dim Handl As Long
Dim XX As AcadEntity
Dim ObjArray(0) As AcadEntity
On Error Resume Next
Num = ThisDrawing.SelectionSets.count
For i = 0 To Num - 1
    Set Sela = ThisDrawing.SelectionSets.Item(i)
    If Sela.Name = "Sela" Then
        Sela.Delete
    End If
Next i
Set Sela = ThisDrawing.SelectionSets.Add("Sela")
Sela.SelectOnScreen

i = 1
If Sela.count > 0 Then
    For Each Obj In Sela
        Obj.GetBoundingBox MinPoint, MaxPoint
            If i = 1 Then
                MinP(0) = MinPoint(0)
                MinP(1) = MinPoint(1)
                MaxP(0) = MaxPoint(0)
                MaxP(1) = MaxPoint(1)
            Else
                If MinP(0) > MinPoint(0) Then
                    MinP(0) = MinPoint(0)
                End If
                If MinP(1) > MinPoint(1) Then
                    MinP(1) = MinPoint(1)
                End If
                If MaxP(0) < MaxPoint(0) Then
                    MaxP(0) = MaxPoint(0)
                End If
                If MaxP(1) < MaxPoint(1) Then
                    MaxP(1) = MaxPoint(1)
                End If
            End If
        i = i + 1
    Next
End If
P1(0) = MinP(0)
P1(1) = MinP(1)
P1(3) = MaxP(0)
P1(4) = MinP(1)
P1(6) = MaxP(0)
P1(7) = MaxP(1)
P1(9) = MinP(0)
P1(10) = MaxP(1)

Set LL = ThisDrawing.ModelSpace.AddPolyline(P1)
LL.Closed = True
Newtuceng '建立新图层
LL.Layer = "b不打印"
InPoint.Delete
'ZoomPrevious

End Sub