The Text Object

Label_Graph
Graphical entities in autocad vba are added with the add### methods which are members of AcadModelSpace, AcadPaperSpace, and AcadBlock.
The object browser shows AcadModelSpace has two members (actually has about 75 add-somethings)

Addtext(string, insertpt, height as double).
AddMText(insertpt, width as double, string)

Simple text is the old style and MText is the new full featured object. The insertion pt is the familiar array of 3 doubles. MText width refers to the box the entire text is within.

To place these in ModelSpace, we establish a link to the current document
Call connect_acad
which gives us the global Acaddoc which is
AcadApplication.ActiveDocument

In the Object Browser, find AcadModelSpace, then right click on its members AddText and AddMText, choose Help, and you get the autocad help with code example with the very least steps to create a text object.

you must declare the correct object, set up the variables, and add text.

Dim textObj As AcadText
Dim MTextObj As AcadMText
Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
Set MTextObj = ThisDrawing.ModelSpace.AddMText(corner, width, text)

in our case since we are running code from excel not inside autocad
Set textObj = AcadDoc.ModelSpace.AddText(textString, insertionPoint, height)
Set MTextObj = AcadDoc.ModelSpace.AddMText(corner, width, text)

The text will come in with the current style. The insert pt for text is lower left ( look up the justify option in the text command and the TextJustify readonly variable if you want to change that). The corner variable in the Mtext argument list is the top left corner of the box. It is the std 3 pt variable array of doubles.

For our application – we are going to add an option to label the graph with the equation. We dont want to add similar code to all our concise routines, but the only place to create a string showing the equation being graphed is in the equation sub. We will create a global string variable and when the equation runs we will fill the variable. The variable will still be available as long as the form is open. The user if he wishes can add the label with a button after the graph is made. To get the text location, we will use the bounding property of a block. our block is the axis. our test wont be too sophisticated – we will take the first block we find that has an insertion point at 0,0. We will use the 4 corners of the axis bounding box as a demonstration at this time, placing plain text and mtext. We will be interested in MText as it will have more options to format our equation, though the vba string variable may be a limitation.
We will create some public variables to hold the text locations and height, and a global pt0 at the origin so we dont have to set up when needed.

Public pt_LL(0 To 2) As Double
Public pt_LR(0 To 2) As Double
Public pt_UR(0 To 2) As Double
Public pt_UL(0 To 2) As Double
Public pt0(0 To 2) As Double
 
Public label_height As Double

Sub set_pt0()
'public variable pt0 is always the origin
pt0(0) = 0: pt0(1) = 0: pt0(2) = 0
End Sub

Sub bigger_label()
label_height = label_height * 1.25
Call label_graph
End Sub

Sub smaller_label()
label_height = label_height * 0.75
Call label_graph
End Sub


Sub label_graph()
'example program to place equation labels at the four corners of the graph
'uses text and mtext
Dim i As Integer
Dim s_set As AcadSelectionSet

If strLabel  "" Then
'fine
Else
MsgBox "strlabel not initialized"
Exit Sub
End If

'sets the four axis boundary pts to use as text inserts
Call get_axis_extents

If pt_LL(0) = 0 Then
MsgBox "did not find an axis"
Exit Sub
End If

If label_height = 0 Then
label_height = 0.5
End If

On Error Resume Next
Set s_set = acadDoc.SelectionSets.Item("graph_labels")
Debug.Print "s_set.count = " & s_set.Count

'if an autocad entity is in s_set but erased thru gui then s_set.erase restores entity
'paradoxically,
'the fix is to iterate through the set with error reporting off
i = s_set.Count
Do While i > 0
i = i - 1 'because ss index is zero based
s_set.Item(i).Erase
Loop

Update
On Error GoTo 0

Call add_ss("graph_labels")
Set s_set = acadDoc.SelectionSets.Item("graph_labels")
 
 Dim textObj1 As AcadText, textObj2 As AcadText
 
 Set textObj1 = acadDoc.ModelSpace.AddText(strLabel, pt_LL, label_height)
 s_set.Select acSelectionSetLast
 Set textObj2 = acadDoc.ModelSpace.AddText(strLabel, pt_LR, label_height)
 s_set.Select acSelectionSetLast
 
 textObj2.Alignment = acAlignmentBottomRight
 textObj2.TextAlignmentPoint = pt_LR
     
 Dim MTextObj1 As AcadMText, MTextObj2 As AcadMText
 
 Dim width As Double
 width = 20 * label_height
 
 Set MTextObj1 = acadDoc.ModelSpace.AddMText(pt_UL, width, strLabel)
 s_set.Select acSelectionSetLast
 Set MTextObj2 = acadDoc.ModelSpace.AddMText(pt_UR, width, strLabel)
 s_set.Select acSelectionSetLast
  
 MTextObj1.height = label_height
 MTextObj2.height = label_height
 MTextObj2.AttachmentPoint = acAttachmentPointTopRight
 MTextObj2.insertionPoint = pt_UR

 Update
End Sub


Sub get_axis_extents()
Dim blockRef As AcadBlockReference
Dim entity As AcadEntity

'the only purpose is to retrieve a block reference inserted at 0,0
'then retrieve its bounding box
'and set global point variables to the 4 corners
'zoom to bounds

'use this as a test if a block was found and the point set
pt_LL(0) = 0

For Each entity In acadDoc.ModelSpace
        If TypeOf entity Is AcadBlockReference Then
            Set blockRef = entity
                If blockRef.insertionPoint(0) = 0 And _
                   blockRef.insertionPoint(1) = 0 Then
                 Exit For
               Else
                Set blockRef = Nothing
              End If
        End If
    Next
    
    If Not blockRef Is Nothing Then
        Debug.Print blockRef.Name
        Dim minExt As Variant, maxExt As Variant
         
        blockRef.GetBoundingBox minExt, maxExt
        Debug.Print minExt(0) & ", " & minExt(1) & ", " & minExt(2)
        Debug.Print maxExt(0) & ", " & maxExt(1) & ", " & maxExt(2)
         
        pt_LL(0) = minExt(0): pt_LL(1) = minExt(1): pt_LL(2) = 0
        pt_LR(0) = maxExt(0): pt_LR(1) = minExt(1): pt_LR(2) = 0
        pt_UR(0) = maxExt(0): pt_UR(1) = maxExt(1): pt_UR(2) = 0
        pt_UL(0) = minExt(0): pt_UL(1) = maxExt(1): pt_UL(2) = 0
         
        acadApp.ZoomWindow minExt, maxExt
        acadApp.ZoomScaled 0.9, acZoomScaledRelative
        Update
    End If

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s