Obviously you can go and customize to your hearts content.
They are plines so that the width can be made to what you need.
Public Sub TitleLine()
Dim objPick As AcadEntity
Dim varPnt As Variant
Dim strPrmt As String
Dim objUtil As AcadUtility
Dim fPt As Variant
Dim rpt As Variant
Dim txtIns As Variant
Dim lin As AcadLine
Dim plin As AcadPolyline
Dim plinpts(0 To 5) As Double
Dim linst(0 To 2) As Double
Dim linend(0 To 2) As Double
Dim fx As Variant
Dim rx As Variant
Dim midx As Variant
Dim modscl As Integer
On Error GoTo ErrHandler
strPrmt = vbCr & "Pick Title: "
Set objUtil = ThisDrawing.Utility
DoOver:
objUtil.GetEntity objPick, varPnt, strPrmt
If TypeOf objPick Is AcadText Then
objPick.GetBoundingBox fPt, rpt
txtIns = objPick.InsertionPoint
If rpt(0) - fPt(0) < 1.75 Then
midx = fPt(0) + (0.5 * (rpt(0) - fPt(0)))
fx = midx - 0.875
rx = midx + 0.875
Else
fx = fPt(0)
rx = rpt(0)
End If
If ThisDrawing.ActiveSpace = acPaperSpace Then
plinpts(0) = fx
plinpts(1) = txtIns(1) - 0.0625
plinpts(2) = 0
plinpts(3) = rx
plinpts(4) = txtIns(1) - 0.0625
plinpts(5) = 0
Set plin = ThisDrawing.PaperSpace.AddPolyline(plinpts)
plin.ConstantWidth = 0.03125
plin.layer = "0"
plin.color = acGreen
linst(0) = fx
linst(1) = plinpts(1) - 0.0625
linst(2) = 0
linend(0) = rx
linend(1) = linst(1)
linend(2) = 0
Set lin = ThisDrawing.PaperSpace.AddLine(linst, linend)
lin.layer = "0"
lin.color = acGreen
Else
modscl = objPick.height / 0.175
plinpts(0) = fx
plinpts(1) = txtIns(1) - (0.0625 * modscl)
plinpts(2) = 0
plinpts(3) = rx
plinpts(4) = txtIns(1) - (0.0625 * modscl)
plinpts(5) = 0
Set plin = ThisDrawing.ModelSpace.AddPolyline(plinpts)
plin.ConstantWidth = (0.03125 * modscl)
plin.layer = "0"
plin.color = acGreen
linst(0) = fx
linst(1) = plinpts(1) - (0.0625 * modscl)
linst(2) = 0
linend(0) = rx
linend(1) = linst(1)
linend(2) = 0
Set lin = ThisDrawing.ModelSpace.AddLine(linst, linend)
lin.layer = "0"
lin.color = acGreen
End If
End If
'GoTo DoOver
ExitNow:
Exit Sub
ErrHandler:
Select Case Err.Number
Case -2147352567
Err.Clear
GoTo ExitNow
Case Else
Err.Clear
GoTo ExitNow
End Select
End Sub