A Better More Complex Text Class

The simple Text class in the previous post does not link to the actual autocad text object, which makes it not fully useful, but it shows the class technique with simple variables of strings and numbers. The autocad text object returned by AddText can also be an object variable in the properties list. Addtext only requires 3 input variables, the string, the insert point, and the text height. Alignment has to be applied after text creation, so the object variable has to be available. the textstyle and layer of the new text object inherit the current autocad settings at time of creation, but alternatively they could be applied just to the text object. A user might be fine with the class changing the textstyle, but changing the layer if he is drawing lines everytime he needs text might not be welcome.

to implement a class where the variables can be set either before or after the actual AddText creation takes a little bit of thought. The first task is to keep the variables involved in an organized list. an excel sheet is a good place to do that. The 3 variables required by addtext are listed first, and the others selected to be managed follow. i only have 3 others, the style, layer and alignment. because of the way alignment works, it actually involves two variables.

go thru the properties of AcadText and make your list.

because everytime a variable is set, the class not only needs to change it, but also it needs to update the autocad drawing – if the autocad text object has been created – there are no longer any public variables. so the private variables have your arcane wordy names, like m_stylename while the Let and Get that control it will have programmer friendly names like Style.

The sub class_initialize that runs everytime a Text object is created sets up default values.

the print subs call sub update_text_props which applies all properties that are not the 3 essentials input to AddText.

when a property is changed, the Let procedure for that property has to change the private variable, then check to see if a text object has been created yet, and if so, apply the new property value to the text in autocad. a simple Function IsTxt returns a boolean true or false.

keep the variable types straight. the autocad object has its must have list of properties. the module has its private list of variables which mostly correspond. the LET and GET procedures are what the programmer will see in the calling program.

with a good structure you can make a partial implementation and add further text object properties later. I did not use obliqueangle, rotation, scalefactor, handle or several others.

Alignment was the most complicated, but its nearly fully implemented here. there are 15 alignment options. each line of text has 4 horizontal lines, top, middle, baseline and bottom. each of those lines has left, center and right positions. thats 12. Baseline Left is the default. There are two more options called Fit and Align. these are the only two not fully implemented, but if you are interested, its mostly done. then there is another one called Middle, that i have not tried to see how it differs from Middle Center yet. Left, Center and Right which all work from Baseline are probably enough for me. I used the same codes that the autocad drawing editor shows at the command line. The enumerated constants are buried in the procedure.

i have left the style loading routine without further review. This might not be its final resting place.

no guarantee this is flawless, but its at least a second generation.

hopefully this will be a useful way to encapsulate the knowledge required to ADDTEXT.

first a screenshot of the excel variable note page. then the code.

Option Explicit
    Private m_txt As AcadText
     'the autocad text object
 'Constants, fixed-length strings, arrays,
 'user-defined types and Declare statements
 'not allowed as Public memebers of object modules
    'these 3 are required by addText
    Private m_textstring As String
    Private m_insertpt() As Double
    Private m_height As Double
    'these change the text object after it is created
    'but they can be set either before or after creation
    Private m_stylename As String
    Private m_layer As String
    Private m_alignment As String

''example usage
'Sub test8()
''    Call Connect_Acad
''    Call insert_delete
''    Dim str As String
''Dim txt1 As New clsText
''    txt1.str = "some text here middle right justify"
''    txt1.insertPt = pt(4, 2, 0)
''    txt1.ht = 0.25
''    txt1.style = "ArialN"
''    txt1.layer = "Bold"
''    txt1.Alignment = "MR"
''    'MsgBox "middle right"
''    txt1.print1
''Dim txt2 As New clsText
''    'uses class defaults
''    txt2.print1
''    txt2.str = "some text here middle left justify"
''    txt2.insertPt = pt(4, 2, 0)
''    txt2.ht = 0.25
''    txt2.style = "RomanS"
''    txt2.layer = "4"
''    txt2.Alignment = "ML"
''    'MsgBox "middle left"
'End Sub

Private Sub Class_Initialize()
    m_insertpt = pt(0, 0, 0)
    m_textstring = "some text"
    m_height = 0.125
    m_stylename = "Standard"
    m_layer = "0"
    m_alignment = "L"

    'MsgBox "initialize"
End Sub

Private Sub Class_Terminate()
    'MsgBox "terminate"
End Sub

Function istxt() As Boolean
    If m_txt Is Nothing Then
        istxt = False
        istxt = True
    End If
End Function

Private Sub update_text_props()
  'called by print subs only
  'assume m_txt is always valid
    m_txt.stylename = m_stylename
    m_txt.layer = m_layer
    Me.Alignment = m_alignment
End Sub

Sub print1()
     Set m_txt = acadDoc.ModelSpace.AddText(m_textstring, m_insertpt, m_height)
End Sub
Sub print2(str As String, ptx() As Double, dblheight As Double)
     Set m_txt = acadDoc.ModelSpace.AddText(str, ptx, dblheight)
End Sub

Sub print3(str As String)
   Dim linefactor As Double
   linefactor = 1.5 * m_height
   m_textstring = str
   m_insertpt = pt(m_insertpt(0), m_insertpt(1) - linefactor, m_insertpt(2))
   Set m_txt = acadDoc.ModelSpace.AddText(m_textstring, m_insertpt, m_height)
End Sub

Public Property Get str() As String
    str = m_textstring
End Property

Public Property Let str(ByVal str1 As String)
    m_textstring = str1
   If istxt Then
        m_txt.textstring = str1
    End If
End Property

Public Property Get insertPt() As Double()
    insertPt = m_insertpt
End Property

'arrays are always passed by reference
Public Property Let insertPt(ByRef ptx() As Double)
    m_insertpt = ptx
    If istxt Then
        m_txt.insertionpoint = ptx
    End If
End Property

Public Property Get ht() As Double
    ht = m_height
End Property

Public Property Let ht(ByVal dblheight As Double)
    m_height = dblheight
    If istxt Then
        m_txt.height = dblheight
    End If
End Property

Public Property Get style() As String
    style = m_stylename
End Property

Public Property Let style(ByVal str1 As String)
    m_stylename = str1
    acadDoc.SetVariable "TEXTSTYLE", str1
    If istxt Then
        m_txt.stylename = str1
    End If
End Property

Sub newstyle(strstylename As String)
    On Error Resume Next
       acadDoc.SetVariable "TEXTSTYLE", strstylename
    If Err Then
        Select Case strstylename
        Case "Arial"
        new_textstyle "Arial", "Arial"
        Case "ArialN"
        new_textstyle "Arial_N", "Arial Narrow"
        Case "Calibri"
        new_textstyle "Calibri", "Calibri"
        Case "Cambria"
        new_textstyle "Cambria", "Cambria"
        Case "Helvetica"
        new_textstyle "Helvetica", "Swis721 BT"
        Case "Palatino"
        new_textstyle "Palatino", "Palatino Linotype"
        Case "Tahoma"
        new_textstyle "Tahoma", "Tahoma"
        Case "Verdana"
        new_textstyle "Verdana", "Verdana"
        Case "Math"
        new_textstyle "Symath_IV50", "Symath_IV50"
        Case Else
        MsgBox "Style value not in my list"
        Exit Sub
        End Select
    End If
    m_stylename = strstylename
End Sub

Private Sub new_textstyle(str_stylename As String, str_typeface As String)

    Dim Bold As Boolean, Italic As Boolean
    Dim lngchar As Long, lngpitch As Long
    lngchar = 0
    lngpitch = 34 'i am sure this is not meaningless but this is typ(swiss 32 variable 2)
    Bold = False
    Italic = False
    Dim TextStyles As AcadTextStyles
    Dim curStyle As AcadTextStyle
    Dim newstyle As AcadTextStyle

    Set curStyle = acadDoc.ActiveTextStyle
    Set TextStyles = acadDoc.TextStyles
    Set newstyle = TextStyles.Add(str_stylename)
    acadDoc.ActiveTextStyle = newstyle
 'new style is added with no font information
 'autocad assigns defaults similar or same as standard
    newstyle.SetFont str_typeface, Bold, Italic, lngchar, lngpitch
    acadDoc.ActiveTextStyle = newstyle
End Sub

Public Property Get layer() As String
    layer = m_layer
End Property

Public Property Let layer(ByVal str1 As String)
    m_layer = str1

    If istxt Then
        m_txt.layer = m_layer
    End If
End Property

Public Property Get Alignment() As String
    Alignment = m_alignment
End Property

Public Property Let Alignment(ByVal str1 As String)
    m_alignment = str1
    Dim align_num As Integer

 Select Case str1

    Case "L"
    align_num = acAlignmentLeft
    'this is the default - baseline left
    'if you set textalignment property at default you get error -
    'not applicable to set textalignmentpoint
    Exit Property

    Case "C"
    align_num = acAlignmentCenter
    Case "R"
    align_num = acAlignmentRight
    Case "AL"
    align_num = acAlignmentAligned
    'not fully implemented until
    'textalignmentpoint input is enabled
    Case "M"
    align_num = acAlignmentMiddle
    Case "F"
    align_num = acAlignmentFit
    'not fully implemented until
    'textalignmentpoint input is enabled
    Case "TL"
    align_num = acAlignmentTopLeft
    Case "TC"
    align_num = acAlignmentTopCenter
    Case "TR"
    align_num = acAlignmentTopRight
    Case "ML"
    align_num = acAlignmentMiddleLeft
    Case "MC"
    align_num = acAlignmentMiddleCenter
    Case "MR"
    align_num = acAlignmentMiddleRight
    Case "BL"
    align_num = acAlignmentBottomLeft
    Case "BC"
    align_num = acAlignmentBottomCenter
    Case "BR"
    align_num = acAlignmentBottomRight
    Case Else
    MsgBox "error in text class alignment code"
    'reset to valid default
    m_alignment = "L"
    Exit Property

End Select

  If istxt Then
        m_txt.Alignment = align_num
        m_txt.textalignmentpoint = m_insertpt
  End If

End Property