Creating a Text frame

I'm trying to figure out how to create a frame around text. I have been using the GetBoundingBox method, and it works great as long as the text has no rotation, but if the text is rotated I end up with some strange results, especially when using the rotation property for acadtext. Any ideas on an alternative?
Thanks,
Matthew Corbin

 

Matthew,
Here's a Function that I found in a post on this group last year. I
don't recall who posted it, and my apologies to the original poster
and/or author. I will usually make a note of it in the code and for some
unknown reason failed to do so with this.

By getting the actual text length based on a 0 degree rotated text
bounding box, you can create your box from there. I use this to
determine whether the length of a line is long enough to have the text
string over it, or place it with a leader.

HTH,
Jeff

Public Function GetTextLength(tx As AcadEntity) As Double
Dim pt1 As Variant, pt2 As Variant
Dim dbLen As Double, dbDist As Double
Dim dbAng As Double, dbTempAng As Double

dbAng = tx.Rotation
If dbAng <> 0 Then
tx.Rotation = 0 ' Change the Text rotation to zero to get the
actual bounding box
tx.GetBoundingBox pt1, pt2
dbTempAng = ThisDrawing.Utility.AngleFromXAxis(pt1, pt2)
dbLen = Cos(dbTempAng) * Distance(pt1, pt2)
tx.Rotation = dbAng ' Change back to its original Rotation Angle
Else
tx.GetBoundingBox pt1, pt2
dbTempAng = ThisDrawing.Utility.AngleFromXAxis(pt1, pt2)
dbLen = Cos(dbTempAng) * Distance(pt1, pt2)
End If
GetTextLength = dbLen
End Function

been using the GetBoundingBox method, and it works great as long as the
text has no rotation, but if the text is rotated I end up with some
strange results, especially when using the rotation property for
acadtext. Any ideas on an alternative?

 

Thanks for the info. How would I incorporate that into this loop...

If TypeOf Entry Is AcadText Then
....
End If
I've selected the text along with some blocks in a selection set and I want to do different things for both types of objects so I've used that IF statement, but I'm still a little new to this and haven't dove into using public functions. At the moment all my code is in one big Sub.

 

Just place the function code in a seperate module. Then in your If
condition:

If TypeOf Entry Is AcadText Then
Dim TextLength As Double
TextLength = GetTextLength(Entry)
'the code to make your box here, using TextLength as your basis
End If

I just thought I should mention, this code will work with blocks,
too.........

Jeff

want to do different things for both types of objects so I've used that
IF statement, but I'm still a little new to this and haven't dove into
using public functions. At the moment all my code is in one big Sub.

 

Jeff,
That was exactly what I was needing. I appreciate your help. No need to use it for the blocks as they are all circles
As always this group never fails to produce results for me!
Kind Regards,
Matthew Corbin