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" '' ''acadApp.Update '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 Else 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) update_text_props End Sub Sub print2(str As String, ptx() As Double, dblheight As Double) Set m_txt = acadDoc.ModelSpace.AddText(str, ptx, dblheight) update_text_props 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) update_text_props 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 'ie 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