2009-03-20

Get in (a)lign....

With text that is. Here is a text alignment snippet I wrote to align some text with a balloon leader (in our industry). It aligns selected text with along two selected points (could be along a line or anything else). Enjoy and get back in (a)lign.

Public Sub AlignSingleLineTextAlongTwoPoints()
'------------------------------------------------------------------------------
'
'
'------------------------------------------------------------------------------
Dim acTxt1 As AcadEntity
Dim vPt1 As Variant
Dim vPt2 As Variant
Dim dScl As Double
Dim dScl1 As Double
Dim dScl2 As Double
Dim dAng As Double
'''''''''''''''''''''''''''''''''''''''
On Error GoTo ErrHandler 'for escape key

Const d45 = 0.7853982 ' 45 degrees in RAD
Const d285 = 1.3089969 ' about 75 degrees in RAD
'''''''''''''''''''''''''''''''''''''''
ThisDrawing.Utility.GetEntity acTxt1, vPt1, "Select Text: "
dScl = acTxt1.height / 3#
dScl1 = dScl * 1.414
dScl2 = dScl * 4.123
'------------------------------------------------------------------------------
vPt1 = ThisDrawing.Utility.GetPoint(, "Select First Point: ")
vPt2 = ThisDrawing.Utility.GetPoint(, "Select Second Point: ")
dAng = ThisDrawing.Utility.AngleFromXAxis(vPt1, vPt2)
'------------------------------------------------------------------------------
'Set the alignment or else the insertion point cannot be overridden below
'REV 2007.12.21
'------------------------------------------------------------------------------
acTxt1.Alignment = acAlignmentLeft
'------------------------------------------------------------------------------
'Set the text insertion point
'------------------------------------------------------------------------------
acTxt1.InsertionPoint = ThisDrawing.Utility.PolarPoint(vPt1, dAng + d45, dScl1)
'------------------------------------------------------------------------------
'Set the text angle
'------------------------------------------------------------------------------
acTxt1.Rotation = dAng

Exit Sub

ErrHandler:
Select Case Err.Number
Case 0
Case -2147352567 'Escape hit
Err.Clear
Case Else
Err.Clear
End Select

End Sub