请问：如何查询Text对象的文字长度？

cobalt

请教各位大侠，如何查询Text对象的文字长度啊？


是不是需要根据文字所属的文字样式得到每个字符的宽度、字符之间的间距，然后自己计算？我想这个肯定也能做，但是各位大侠有没有好的办法？

laoliu09

这很简单嘛，如果text对象没有宽度属性，那可以求text对象的包围矩形，包围矩形的宽度就是text对象的宽度，当然，你还要根据text对象的旋转角度具体判定，水平放置的text对象当然最容易求宽度啦！

cobalt

多谢你的提醒啊，我倒是忘了用几何的办法来判断了。多谢多谢。我也把源代码贴在这里吧，楼下的也可以看出其中的关系。呵呵 Sub GetTextWidth()
Dim Obj As AcadObject
Dim ObjText As AcadText, ObjLWLine As AcadLWPolyline, ObjLWLine2 As AcadLWPolyline
Dim InsertPoint(0 To 2) As Double, MinPoint As Variant, MaxPoint As Variant

For Each Obj In ThisDrawing.ModelSpace
Obj.Delete
Next

InsertPoint(0) = 10
InsertPoint(1) = 10
InsertPoint(2) = 0
Set ObjText = ThisDrawing.ModelSpace.AddText("123456", InsertPoint, 10)
ObjText.GetBoundingBox MinPoint, MaxPoint
Set ObjLWLine = DrawLWPolylinebyTwoPoints(ThisDrawing, MinPoint, MaxPoint)
Set ObjLWLine2 = ObjLWLine.Copy
ObjText.Rotate InsertPoint, 30 * 3.1415926 / 180
ObjLWLine.Rotate InsertPoint, 30 * 3.1415926 / 180
ObjText.GetBoundingBox MinPoint, MaxPoint
Set ObjLWLine = DrawLWPolylinebyTwoPoints(ThisDrawing, MinPoint, MaxPoint)
ZoomExtents End Sub '根据两个角点绘制LWPolyline
Public Function DrawLWPolylinebyTwoPoints(AcadDoc As AcadDocument, Pt1 As Variant, Pt2 As Variant) As AcadLWPolyline
On Error Resume Next
Dim PtArray(0 To 7) As Double
PtArray(0) = Pt1(0): PtArray(1) = Pt1(1)
PtArray(2) = Pt2(0): PtArray(3) = Pt1(1)
PtArray(4) = Pt2(0): PtArray(5) = Pt2(1)
PtArray(6) = Pt1(0): PtArray(7) = Pt2(1)
Set DrawLWPolylinebyTwoPoints = AcadDoc.ModelSpace.AddLightWeightPolyline(PtArray)
DrawLWPolylinebyTwoPoints.Closed = True
End Function

laoliu09

我爱编程，共同提高吧！