Vectors and Geometry

exercises from “Linear Algebra”, David Poole, 2006, Thomson

To find a number half-way between two numbers, add them then divide by two. Similarly, to find a midpoint of a line add the coordinates of the endpoints and divide by two.

Since a vector and a point have the same data structure, to find a vector half way between two other vectors, it has a different notation, but it breaks down to the same calculation.

We use the standard notation to show points as Capitals. Vectors to those points are lower case. VBA vector variables are lower case. VBA points will be as ptA, ptB etc, although since Points and Vectors in VBA have identical data structures we dont need to double declare. Vectors are mobile. The algebra of vectors does not depend on position. To draw them in autocad, a start position is specified.

Given two vectors a and b, the vector from a to b is b-a. This is practically the definition of a vector. In autocad a line has a startpoint and endpoint. The vector represented by that line is the difference from start to finish. The line can be moved or copied, and as long as it is not rotated or stretched, it represents the same vector. The total difference of the coordinates is the vector. Autocad Lines have properties of DeltaX, DeltaY and DeltaZ. These do not change when the line is copied and moved. They are the vector.

If we take a line with endpoints A and B, the vectors from the origin to those points are a and b. If we define a vector from the origin to the midpoint of the line as m, then the vector from a to m is m-a. m-a is already defined as 1/2 (b-a), so we have an equation that we can simplify to get the result – given two points A and B, the vector to the midpoint is m = 1/2 (a + b).

In this diagram a parallelogram diagonal shows the result of adding two vectors. When they are subtracted the result is represented by the diagonal between them. The diagonals bisect each other, so that in this case half of the long diagonal, 1/2 (a + b) is equal to m.

To find a point a third of the way between two points, or in general any fraction, requires to go back to the original equation.

Vector algebra can be used to prove and illustrate geometry.

A line from the midpoints of two sides of a triangle is half the length and parallel to the other side. Here we use the vector midpoint formula to find the midpoints of sides of a triangle, then subtract those vectors from each other to find a vector equation for the line joining them, then simplify that equation to see that it is exactly one half the length of the other side. The figure is drawn in vba and the same calculation made to verify the result.

An arbitrary quadrilateral which has its midpoints joined forms a parallelogram. The vectors on opposite sides are compared in VBA to see if they have identical values.

doing the calculation g = 1/3 (a + b + c) also draws a vector to the centroid G.

I had trouble with this one. It is not solved with vector methods. The altitude of a triangle is a line from a vertex perpendicular to the other side. The 3 altitudes intersect at a point called the orthocenter. Prove this by finding the intersection of two altitudes and show the third one goes thru the point and is perpendicular to the third side. I could not figure out how to get vector h. I used the point-slope form of a line, and the fact that two lines are pendicular if their slopes are the negative inverse. but it only showed it was true for this particular set of coordinates.

perhaps something something

Vectors 3

This is my third try at vectors. It starts with basic vector algebra.

A vector is an ordered triple of numbers, representing the xyz coordinates of the head, the tail at 0,0,0. A vector and a point have the same structure, an array of 3 doubles. Vector algebra functions accept a vector as input and return the calculated vector. Position comes into play when we want to display the vector in autocad. (these are NOT all debugged on first draft)

Here are the elementary vector functions.
Plus (U,V) returns vector U + V
Minus (U,V) returns vector U – V
Scalar(c, U) returns vector c * U
Dot(U, V) returns double dot product
Leng(U) returns double length of vector
UnitV(U) returns unit vector along U
Dist(U, V) returns double distance between vectors
Angle(U, V) returns angle between vectors as double in radians
Ortho(U, V) returns boolean True if vectors are perpendicular
Proj(U, V) returns vector V projected on U
Neg(U) returns negative vector

Draw(vec) Draws vector in autocad as simple line

the function to create a point takes the triples input and returns the array of 3 doubles.

dim pt1() as double
pt1 = PT(1,2,3)

this is used as the basic vector creation function.

dim u() as double
u= VEC(1,2,3)

Function vec(x As Double, y As Double, z As Double) As Double()
    Dim pnt(0 To 2) As Double
    pnt(0) = x: pnt(1) = y: pnt(2) = z
    vec = pnt
End Function
Function plus(u() As Double, v() As Double) As Double()
    Dim w(0 To 2) As Double
    w(0) = u(0) + v(0)
    w(1) = u(1) + v(1)
    w(2) = u(2) + v(2)
    
    plus = w
End Function

Function scalar(c As Double, u() As Double) As Double()
    Dim w(0 To 2) As Double
    w(0) = c * u(0)
    w(1) = c * u(1)
    w(2) = c * u(2)
    
    scalar = w
End Function

Function minus(u() As Double, v() As Double) As Double()
    Dim w(0 To 2) As Double
    w(0) = u(0) - v(0)
    w(1) = u(1) - v(1)
    w(2) = u(2) - v(2)
    
    minus = w
End Function

Function dot(u() As Double, v() As Double) As Double
    Dim w As Double
    w = u(0) * v(0) + u(1) * v(1) + u(2) * v(2)
    dot = w
End Function

Function leng(u() As Double) As Double
    Dim w As Double
    w = u(0) ^ 2 + u(1) ^ 2 + u(2) ^ 2
    w = Sqr(w)
        
    leng = w
End Function

Function unitv(u() As Double) As Double()
    Dim w() As Double
    Dim L As Double
    
    L = leng(u)
    w = scalar(1 / L, u)

    unitv = w
End Function

Function dist(u() As Double, v() As Double) As Double
    Dim L As Double
    L = leng(minus(u, v))
    
    dist = L
End Function

Function angle(u() As Double, v() As Double) As Double
    Dim Dot_UV As Double
    Dim len_U As Double
    Dim len_V As Double
    Dim cos_theta As Double
 
    Dot_UV = dot(u, v)
    len_U = leng(u)
    len_V = leng(v)
    
    cos_theta = Dot_UV / (len_U * len_V)
    
    angle = WorksheetFunction.Acos(cos_theta)
End Function

Function ortho(u() As Double, v() As Double) As Boolean
    Dim w As Double
    w = dot(u, v)
    
    If w = 0 Then
    ortho = True
    Else
    ortho = False
    End If
End Function

Function proj(u() As Double, v() As Double) As Double()
    Dim w() As Double
    Dim x As Double
    Dim Dot_UV As Double
    Dim Dot_UU As Double
        
    x = Dot_UV / Dot_UU
    w = scalar(x, u)
    
    proj = w
End Function

Function neg(u() As Double) As Double()
    Dim w(0 To 2) As Double
    w(0) = -1 * u(0)
    w(1) = -1 * u(1)
    w(2) = -1 * u(2)
    
    neg = w
End Function

To draw a vector in autocad, this is borrowed from the line wrapper, I kept the optional layer parameter even though i dont intend to use it much at first.

g_pt is a public point variable, same as a vector, if we set it each time, its easy to draw vectors end to end.
we could save the newly created line object the same way, and sometimes thats useful, but i removed it for now.


Public u() As Double
Public v() As Double
Public g_pt() As Double

Sub draw(vec() As Double, startpt() As Double, Optional strlayer As Variant)
    Dim lineobj As acadline
    Dim endpt() As Double
        
    endpt = pt(vec(0) + startpt(0), vec(1) + startpt(1), vec(2) + startpt(2))
    Set lineobj = acadDoc.ModelSpace.AddLine(startpt, endpt)
        
    If Not IsMissing(strlayer) Then
       lineobj.Layer = strlayer
    End If
         
    g_pt = endpt
 
  End Sub

Acad Table — Array — Excel Sheet

EXCEL — ARRAY — ACAD TABLE

Two way transfer of data to/from autocad table from/to excel worksheet using arrays.

Excel is the BOM (or cut-list) that Autocad has always needed, but editing tables in Autocad is slow and awkward. Being able to dump them back to excel, edit, then re-load them to the same table is sometimes much faster than editing in place.

We need 4 basic methods.

Excel range to array
Array to excel range
Autocad table to array
Array to autocad table

We will make functions and return the newly made or modified object. We will take object arguments for the input. We will keep these as single purpose as possible to be used by multiple calling programs.

Excel makes it easy to transfer sheet contents to an array or vice versa. It is simply

Array = range
Or
Range = array

There are some details. Acad Table requires a loop both to get and put data. When we do Array = Range then excel sizes the array automatically. We defined the range. When we make the array from the acad table, we Redim array (1 to rows, 1 to cols).

The four main sub/functions are –

Function xl_to_arr (rng as range) as variant
Sub arr_to_xl (arr as variant, rng as range)

Function acadtbl_to_arr(tbl as acadtable) as variant
Sub arr_to_acadtbl (arr as variant, tbl as acadtable)

If you use this method to delete rows (in autocad), keep the same number, re-sort rows, this works great as-is. You are just changing data. If you add rows or columns, you will likely have formatting problems. You can manually fix them. To do so programmatically, you would copy the formatting of the row above or column to the left. Its worth doing, but definitely non-trivial. Autocad tables have nearly 100 methods and properties. The vba help files for tables seem like many just appear to be stubs. For me, changing the alignment, tbl.SetCellAlignment r, c, acMiddleLeft Right or Center, and changing the texheight, SetTextHeight acDataRow (as opposed to Title or Header) dblvalue, do the job. Alignment is set per cell, and textheight only has to be set once if all rows are data rows. Non-trivial but worth doing.

This would be a good place to have a long discussion about arrays, but i am going to table that til i have my information better organized. Static arrays are not very useful, but all texts start there. Dynamic arrays are the norm. They can also accept assignment, which is not covered at all in most texts. I dont know when vba changed that, but they must have. There is no reason i have found not to use them all the time. Autocad uses variant arrays in their help when dynamic arrays would work fine. A variant data type can contain an array, and is the only choice most of the time to read and write to excel. Also the data in a table is going to be a combination of strings, integers and doubles, so a dynamic array of a single type wont work. I have a post in mind that is nothing but arrays.

An array made from an excel sheet always has a lower index of 1, no matter what the option base is. Autocad tables always have first row and column index of zero. Keep that straight and your loops will be simpler. I save the array from autocad with a base of 1.

For r = 1 To rows
For c = 1 To cols
arr(r, c) = tbl.GetText(r – 1, c – 1)
Next c
Next r

Traditional row and column variables for looping thru a table are i and j. I prefer r and c, row and column, for legibility. Rows always come first. (r,c) as distinct from excel sheet nomenclature (“A1”). Autocad tables are (r,c)

The four main subs are here, followed by the two calling programs, tbl_to_xl and xl_to_tbl. There is also a get_table function to return the object table from autocad by user selection. This could be selected other ways, such as by a location of the upper left of the table, if it is always at the same location. And last, there is an array report that writes to the debug window that i was using while developing and did not want to erase.

I can run both sides of the program from the code window or a button on a form. I have a sheet in excel with the proper name.

'the four main function subs
Function xl_to_arr(rng As Range) As Variant
     
     xl_to_arr = rng
     
End Function


Sub arr_to_xl(arr As Variant, rng As Range)
    Dim rows As Integer, cols As Integer
    rows = UBound(arr, 1) - LBound(arr, 1) + 1
    cols = UBound(arr, 2) - LBound(arr, 2) + 1
    
    'resize the range to be same as array
    Set rng = rng.Resize(rows, cols)
    
    rng.Value = arr
    'data is on the sheet
    
End Sub

Function acadtbl_to_arr(tbl As AcadTable) As Variant
    Dim r As Integer, c As Integer
    Dim rows As Integer, cols As Integer
    
    rows = tbl.rows
    cols = tbl.Columns
    
    Dim arr As Variant
    ReDim arr(1 To rows, 1 To cols)
    
    For r = 1 To rows
        For c = 1 To cols
            arr(r, c) = tbl.GetText(r - 1, c - 1)
        Next c
    Next r
    
    acadtbl_to_arr = arr

End Function


Sub arr_to_acadtbl(arr As Variant, tbl As AcadTable)

    Dim rowLbound As Integer, rowUbound As Integer
    Dim colLbound As Integer, colUbound As Integer
    Dim rows As Integer, cols As Integer
           
    rowLbound = LBound(arr, 1)
    rowUbound = UBound(arr, 1)
    colLbound = LBound(arr, 2)
    colUbound = UBound(arr, 2)

    rows = rowUbound - rowLbound + 1
    cols = colUbound - colLbound + 1
 
    'resize the autocad table
    tbl.rows = rows
    tbl.Columns = cols
  
  Dim r As Integer, c As Integer
  
If rowLbound <> 1 And colLbound <> 1 Then
MsgBox "Lbound not eq 1 in arr to acadtbl, exiting"
Exit Sub
End If

     For r = 1 To rows
         For c = 1 To cols
             If Not IsEmpty(arr(r, c)) Then
                tbl.SetText r - 1, c - 1, arr(r, c)
             End If
          Next c
       Next r

    acadApp.Update
     
End Sub

i use a couple globals in the calling programs.


Public g_tbl As AcadTable
Public g_arr As Variant

Sub tbl_to_xl()
    Call Connect_Acad
    
    Set g_tbl = get_table
     
     If g_tbl Is Nothing Then
     'MsgBox "table is nothing"
     Exit Sub
     End If
         
    g_arr = acadtbl_to_arr(g_tbl)
    
    Call arr_report(g_arr)
        
    Dim ws1 As Worksheet, rng As Range
    Set ws1 = ThisWorkbook.Sheets("Chan_List")
    Set rng = ws1.Range("A1")
        
    Call arr_to_xl(g_arr, rng)
    
    ws1.Activate
End Sub

Sub xl_to_tbl()
Call Connect_Acad

    If g_tbl Is Nothing Then
     Set g_tbl = get_table
     End If
 
    Dim ws1 As Worksheet, rng As Range
    Set ws1 = ThisWorkbook.Sheets("Chan_List")
    Set rng = ws1.Range("A1")
    Set rng = rng.CurrentRegion
     
    g_arr = xl_to_arr(rng)
    
     Call arr_report(g_arr)
    
    Call arr_to_acadtbl(g_arr, g_tbl)
End Sub


Function get_table() As AcadTable
        Dim pt() As Double
        Dim obj As Object
        On Error Resume Next
        
        acadDoc.Utility.GetEntity obj, pt, "Select a table"
    
    If Err <> 0 Or obj.EntityType <> acTable Then
        Err.Clear
        MsgBox "table not selected"
        Exit Function
    End If
    
    On Error GoTo 0
      
    If obj.EntityType = acTable Then
       Set get_table = obj
    End If
    
End Function


Sub arr_report(arr As Variant)
    
    Dim rowLbound As Integer, rowUbound As Integer
    Dim colLbound As Integer, colUbound As Integer
    Dim rows As Integer, cols As Integer
    
    rowLbound = LBound(arr, 1)
    rowUbound = UBound(arr, 1)
    colLbound = LBound(arr, 2)
    colUbound = UBound(arr, 2)
    
    rows = rowUbound - rowLbound + 1
    cols = colUbound - colLbound + 1
    
    Debug.Print "arr: " & IsArray(arr)
    Debug.Print "arr: " & VarType(arr)
    Debug.Print "arr: " & TypeName(arr)
     
    Debug.Print "row : " & rowLbound & " to "; rowUbound
    Debug.Print "col : " & colLbound & " to "; colUbound
    Debug.Print "rowcount: " & rows
    Debug.Print "colcount: " & cols
    
    Debug.Print
 
End Sub

Autocad Text Class

Autocad Text Class

There are two text objects, plain old single line TEXT and new fancy multi-line MTEXT. By new I mean Rel 13 which was in 1994. Not that new.

Simple TEXT is created with AddText and MTEXT with AddMText both of which are methods of ModelSpace.
Simple TEXT uses a variable type ACADTEXT and MTEXT uses ACADMTEXT.

Links to autocad’s oddly hard to find help pages. Hold down your CTRL key when you click them so they load in a new tab. ActiveX is the key search term. Developers Guide and Reference Guide are the key clicks. The Object Model diagram with clickable labels is very useful. The methods to create an object are almost all a method of modelspace. Click on modelspace in the Object Model diagram to see its methods, such as AddText. Later click on the TEXT object itself to see its properties and methods, i.e. what you can change about it after it is created.

http://help.autodesk.com/view/OARX/2018/ENU/

https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2018/ENU/AutoCAD-ActiveX-Reference/files/GUID-A809CD71-4655-44E2-B674-1FE200B9FE30-htm.html

So you get to Modelspace Collection (ActiveX) and you find a list of ADD methods one of which is AddText. Then you have the syntax and sample code in VBA and Lisp

http://help.autodesk.com/view/OARX/2018/ENU/?guid=GUID-C541B6F2-1279-4D1C-8DC0-788F27F644EF#GUID-C541B6F2-1279-4D1C-8DC0-788F27F644EF

Now you have the method to create, return to the object model diagram and click on TEXT to see what you can do with a TEXT object.

http://help.autodesk.com/view/OARX/2018/ENU/?guid=GUID-ED298AC7-19E0-4E54-8983-48439EF70116#GUID-ED298AC7-19E0-4E54-8983-48439EF70116

The list of methods and properties, of an existing text object, that autocad shows on its help page, is the same list that VBA shows in the auto list members popup box (also called intellisense) that shows the available methods and properties to an object.

The autocad properties window has almost the same list of TEXT properties, but not the methods.

I thought I had code problems, but autocad text alignment is bizarre. Any attempt to change text alignment was bouncing the whole string down to 0,0. Notice in the help (link below) the phrase, will reset to 0,0,0. Yeah thats right. Here is where the help example helps. It works fine. Why does theirs work and not mine? There is a second variable to set other than Alignment. A bit more of a flagged warning would save time. I dont think its quite like they say. The point is not changed, you can read it, its 0,0,0, but you cannot write to it until the alignment is changed, then its default of 0,0 is used immediately as the insertion point – the text is moved to a random point of 0,0,0 – you can see it by stepping thru the help example. The text location then must be returned to its intended position by setting TextAlignmentPoint to the original insertionpoint. This is very curious.

http://help.autodesk.com/view/OARX/2018/ENU/?guid=GUID-13212A9D-A3B9-4957-B1B7-E1A77E092582

Text is inserted at pt1 with insertion point at default lower left. Alignment is changed to lower right. The textalignment point now comes in to play, it is placed at the lower right of the text, and the text is moved so that lower right is at 0,0. Insertionpoint value is changed so it is at lower left. User runs code to set textalignment to pt1. Changing alignment changes insertionpoint by a random vector depending on how far the insertionpoint is from the origin. I dont think that will ever make sense. Clearly calculating the other end of the line is very complicated. It is as if they moved it to 0,0 to measure it. Insertionpoint is always lower left. In the properties window they call it Geometry Position X, Y, Z.

Here is the text wrapper with two global variables. Height is optional in the sub. If height is missing, then the global TextHeight is used. If TextHeight has not been set, then it is set to 1/8. This takes care of conventional (not class based) TEXT.

The text object g_txt is global so all the various properties can be set in the calling program.

Public TextHeight As Double
Public g_txt As AcadText


 Sub txt1(str As String, ptx() As Double, Optional height As Variant)
      If TextHeight = 0 Then TextHeight = 0.125
      
      If IsMissing(height) Then
        height = TextHeight
      End If
 
  Set g_txt = acadDoc.ModelSpace.AddText(str, ptx, height)
  g_txt.Layer = "0"
 End Sub


Sub test1()
‘Demo create and modify text
    Dim str As String
    Call Connect_Acad
    Call insert_delete ‘cheapest low tech way to import layers, styles etc.
    
TextHeight = 0.125

pt1 = pt(3, 2, 0)
str = "some text here"

txt1 str, pt1

g_txt.Layer = "bold"
g_txt.StyleName = "ArialN"
g_txt.textString = "change this text"


g_txt.Alignment = acAlignmentBottomRight
g_txt.Update

'text is now with lower right at origin
'insertionpoint is at lower left

MsgBox g_txt.insertionPoint(0) & " , " & g_txt.insertionPoint(1)

'move text back so lower right is original insertionpoint
g_txt.TextAlignmentPoint = pt1

'insertionpoint is still lower left
MsgBox g_txt.insertionPoint(0) & " , " & g_txt.insertionPoint(1)

g_txt.Update

    'all these and more are available
    'g_txt.Alignment
    'g_txt.GetBoundingBox
    'g_txt.Delete
    'g_txt.height
    'g_txt.InsertionPoint
    'g_txt.IntersectWith
    'g_txt.Layer
    'g_txt.Move
    'g_txt.ObjectID
    'g_txt.ObjectName
    'g_txt.ObliqueAngle
    'g_txt.Rotate
    'g_txt.Rotation
    'g_txt.ScaleEntity
    'g_txt.ScaleFactor
    'g_txt.StyleName
    'g_txt.TextAlignmentPoint
    'g_txt.TextString

End Sub

Now lets work on a Class implementation of the same thing.

Insert a Class Module.
Rename it to clsText.
You now have a blank module identical to a standard Module except there is more of an emphasis on module level variables, which are the properties of your Text object. Variables can be public or private. Public variables are simple and straightforward. Private variables require procedures to set and retrieve them called Let and Get. (Set is used for object variables.) Public variables require simple meaningful names. You can get started just by using the list of VBA properties of Text objects.

Start with the minimum requirement to make Text,
Modelspace.Addtext (string, insertpoint, height)

Public textString as string
Public height as double

Insertpoint is an array of 3 doubles. As soon as you try to make that a public variable and compile the module, VBA gives an error and informs you

‘Constants, fixed-length strings, arrays, user-defined types and Declare
‘statements not allowed as Public members of object modules

Private m_insertpt() as double

The m prefix stands for module, to me. Private variables are accessed thru public procedures. The name of the procedure is what shows in the calling program and the procedure and the variable cannot have the same ambiguous name to the compiler. So the procedure gets the simple meaningful name when the variable is private. The calling program does not know if the property is a public variable or a public procedure calling a private variable.

When the variable is public, it is simply called as a property of the object variable. First the object must be created in the calling program, then the properties can be set.

Dim txt1 As New clsText
txt1.textString = “some text here”
txt1.height = 0.125

The simple way I am doing this, there is no actual connection between the object in VBA and the text object created in autocad. Once the text object is created in autocad, the class object in vba no longer has control of it. So the properties have to be set prior to creation and the current environment in autocad will determine style, layer, everything. However we will be able to set all that prior to creating the text.

Our goal is

Txt1.print1
Or/And
Txt1.print2 Textstring, insertpoint, height

The only other thing we need to create Text is to be able to set the InsertPoint. Even though we dont need it, lets look at Let and Get for TextString because its a simpler case than setting it for a point array.

Change the variable to private.

Private m_textString As String

From the menu pulldown Insert Procedure. Type Textstring for name, check property box. VBA inserts two generic Property stubs, Get and Let.

Public Property Get TextString() As Variant

End Property

Public Property Let TextString(ByVal vNewValue As Variant)

End Property

Change the variable to string. Change the passed variable name to something you like.

Get is something like a function, it passes back the value. Get is reading the private variable and returning it. So it becomes

Public Property Get TextString() As String
    TextString = m_textString
End Property

Let is more like a Sub with a passed argument. It is setting the private variable.

Public Property Let TextString(ByVal str As String)
    m_textString = str
End Property

The calling program though doesnt look like a sub. Textstring is a property of the Text object.

txt1.TextString = “some text here”

The Property procedures control the values and can do more than just set them.

VBA would not allow us to make a point array public, so we need those property procedures. We could separate the xy and z values, but I have come to prefer always passing them together in a dynamic array.

Private m_insertpt() As Double

Dynamic arrays are always passed by reference, Get is passing back an array of doubles and Let is passing in an array. This is the same method and syntax I have used in standard modules.

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
End Property

Now we need the print method. I wanted to do Debug.print only Text.Print but print is a reserved word, so it has to be Print1, but that worked out because we can do different versions of Print.

I left textstring as private, though it doesnt need to be. The insertpoint has to be private, and height can be public. Height is a pretty generic name, I would not be too surprised if it conflicted with something at some time.

 Sub print1()
     Dim acadtxt1 As AcadText
     Set acadtxt1 = acadDoc.ModelSpace.AddText(m_textString, m_insertpt, height)
  End Sub

We can also pass in the variables. We have to make choices how we want it to work. The passed in variables could update the class variables, or just bypass them.

 Sub print2(str As String, ptx() As Double, height As Double)
     Dim acadtxt1 As AcadText
     Set acadtxt1 = acadDoc.ModelSpace.AddText(str, ptx, height)
 End Sub

Here is a print variation that only takes string as an argument, and increments the line down everytime it is run.

Sub print3(str As String)
    
   Dim linefactor As Double
   linefactor = 1.5 * height
   
    m_textString = str
    m_insertpt = pt(m_insertpt(0), m_insertpt(1) - linefactor, m_insertpt(2))
  
    Dim acadtxt1 As AcadText
    Set acadtxt1 = acadDoc.ModelSpace.AddText(m_textString, m_insertpt, height)
     
 End Sub

We need a little textstyle control. Here is the minimum way with no error checking. Later we will create the style if it is not found.

Private m_styleName As String

Public Property Get styleName() As String
    styleName = m_styleName
End Property

Public Property Let styleName(ByVal strstylename As String)
    acadDoc.SetVariable "TEXTSTYLE", strstylename
    m_styleName = strstylename
End Property

Now finally, we can run a test sub and see autocad output.

Sub test3()

Call Connect_Acad
Call insert_delete

Dim txt1 As New clsText
txt1.TextString = "some text here"
txt1.height = 0.125
txt1.insertPt = pt(4, 3, 0)
txt1.print1

Dim str As String
str = " different text"
txt1.print2 str, pt(4, 2, 0), 0.25

txt1.insertPt = pt(8, 3, 0)
txt1.height = 0.125

txt1.print3 "line 1"
txt1.print3 "line 2"
txt1.print3 "line 3"
txt1.print3 "line 4"
txt1.print3 "line 5"

txt1.styleName = "Calibri"
txt1.print3 "line 6"

End Sub

We can take advantage of our text class module and add some textstyle creation help. The code is the same as it would be outside the class, I already had it, but this seems like a convenient place to put it. This is not finished bullet proof, I wanted to leave the textstyle property simple for a first go. So here is a newstyle method, not a property.

First the basic text style creation sub which is private. Given the proper data, it can create any style. I think it came more or less straight out of autocad vba help.

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

Now the public interface. It will be called like this. It maintains a list of favorites. Its simple, not slick.

txt1.newstyle “Arial”

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

The test sub –

Sub test4()
Call Connect_Acad
Call insert_delete

Dim txt1 As New clsText
txt1.height = 0.125
txt1.insertPt = pt(4, 3, 0)

Dim str As String
str = "   AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz"

txt1.newstyle "Arial"
txt1.print3 "Arial" & str

txt1.newstyle "ArialN"
txt1.print3 "ArialN" & str

txt1.newstyle "Calibri"
txt1.print3 "Calibri" & str

txt1.newstyle "Cambria"
txt1.print3 "Cambria" & str

' actually Swis721 BT
txt1.newstyle "Helvetica"
txt1.print3 "Helvetica" & str

txt1.newstyle "Palatino"
txt1.print3 "Palatino" & str

txt1.newstyle "Tahoma"
txt1.print3 "Tahoma" & str

txt1.newstyle "Verdana"
txt1.print3 "Verdana" & str

txt1.newstyle "Math"
txt1.print3 str

End Sub

And the output – generated with Text Class methods

Strings as Symbols

If we can interpret strings as symbols, we can store parameter data in spreadsheets.

The basic technique uses VBA statements Replace and Evaluate.

Sub test()
Dim A As Double, B As Double, C As Double, D As Double, R As Double

Dim str As String

str = "A + B * C + D"

A = 5
B = 3
C = 2
D = 3

str = Replace(str, "A", A)
str = Replace(str, "B", B)
str = Replace(str, "C", C)
str = Replace(str, "D", D)

R = Evaluate(str)

MsgBox R

End Sub

Lets use a simple polyline box to illustrate the all-in-code method versus the data-in-spreadsheet method.

If the box is A wide (in the x direction) and B tall (in the y direction), and the lower left corner is at 0,0, the points are (0,0) (A,0) (A,B) (0,B)

AddLightWeightPolyline will draw the box if the 8 data entries are given in an array in sequence. The CLOSED property of the polyline object is set to true to draw the line from the last point back to the first point.

In code
X0=0
X1=A
Y0=0
Y1=B

Dim pts as variant
Pts = Array (x0, y0, x1, y0, x1, y1, x0, y1)

The array named pts is then handed off to a sub that will convert it to a format AddLightWeightPolyline can handle.

For any complex shape a labeled drawing is necessary. Creating the array is a two-step process. x and y values are found starting from the origin in relation to the parameters A and B (and any others necessary). Then the x and y values are listed as needed in the array in the order that the polyline vertices require. At runtime the x and y values have their formulas evaluated and the results are stored in the array given to the polyline sub to be drawn.

To duplicate this with the data in a spreadsheet, the process has to be collapsed to a single step. We need to store the formulas in the order the polyline requires them, not evaluate them to x and y symbols first.

At first the added complexity of that was tedious. But eventually I learned to enter the formulas per the sketch just doing all the x values, in the order they are to be drawn, then do all the y values, similar to the code process. The benefits of putting the data into a spreadsheet are that we can have a whole sheet of parts, and we can manipulate the data and the finished part easily.

In standard database design, every table has a unique name with one column that has unique values called a primary key. The record (row) is found by finding the unique value in the key column. If we call the spreadsheet table SHAPE then the unique column will be called SHAPE_ID. We find the row data by the name of the shape we are looking for. For instance, the key column is column B, the shape we are looking for is “OSCF”, then

Set rng = ws1.Range(”B1:B30”).Find(”OSCF”)

Find has arguments. If the lookat:=xlWhole is not set, Find will search and find the substring, so that searching for OSCF will stop when OSCF1 is found. Also it is written that VBA saves its last search parameters, and uses them when there are no arguments to the contrary, which could lead to some pretty confounding bugs.

Set rng = ws1.Range(”B1:B30”).Find(”OSCF” , LookIn:=xlValues, lookat:=xlWhole)

in practice variables will be used for the range and search string

Set rng = ws1.Range(shape_key).Find(shape_ID, LookIn:=xlValues, lookat:=xlWhole)

If found, this will set the excel range object to the single cell that contains the found string.

If our data is extended out to the right, and there is a blank column after the last cell, then

First we move the range one cell to the right to pick up the first data cell

Set rng = rng.Offset(0, 1)

Then we extend the range all the way to the right, a variable number of columns depending on the individual record.

Set rng = ws1.Range(rng.Address, rng.End(xlToRight).Address)

Ws1 is a sheet reference.

Now we have the data, whatever it is, in a range object. In the cells are our formulas. Here are the values for OSCF,

A, B, and W are defined by the user at run time. But the strings A, B and W in the spreadsheet are not the symbols A, B and W in VBA.

The range is saved. We count the number of items in it and re-dimension the array to accept it.

icount = rng.Count
ReDim ar(1 To icount)

Now we can loop through the range. Each time through the loop we get the cell value in a string. Then we use VBA Replace to change the string values A, B, W to their symbols which at runtime have actual numerical values. Finally we use VBA Evaluate to do the math and load the result into the array. The finished array is an array of doubles and suitable for the AddLightWeightPollyLine method.


Sub shape_2(shape_ID As String, A As Double, B As Double, C As Double, D As Double, W As Double)
 Dim i As Integer, icount As Integer
 Dim str As String
 Dim rng As Range
 Dim plineobj As AcadLWPolyline
  
 Dim ar() As Double
 Dim shape_key As String
 
 Set ws1 = ThisWorkbook.Worksheets("Shape_Param")
 shape_key = "B1:B30"
 Set rng = ws1.Range(shape_key).Find(shape_ID, LookIn:=xlValues, lookat:=xlWhole)

 
 If rng Is Nothing Then
   MsgBox "no find shape_ID in column shape_key"
    Exit Sub
    End If
   
    'rng has one cell,  offset it one cell right to begin data
    Set rng = rng.Offset(0, 1)
    'extend the range to right to the end of the record
     Set rng = ws1.Range(rng.Address, rng.End(xlToRight).Address)
     'this also works but it seems like it shouldnt
     'because excel seems to infer the range default as address
     'Set rng = Range(rng, rng.End(xlToRight))
        icount = rng.Count
        ReDim ar(1 To icount)
    
    For i = 1 To icount
        str = rng.Cells(1, i)
        str = Replace(str, "A", A)
        str = Replace(str, "B", B)
        str = Replace(str, "C", C)
        str = Replace(str, "D", D)
        str = Replace(str, "W", W)
        
        ar(i) = Evaluate(str)
    Next i

  Set plineobj = acadDoc.ModelSpace.AddLightWeightPolyline(ar)
      plineobj.Closed = True
      plineobj.Update
      Set g_pline = plineobj

End Sub

The created polyline can be a global variable and the calling program can draw several shapes and move, rotate, mirror them into assemblies. For drawing sheet metal end sections, either the part can be drawn with a thickness, a closed polyline, or a single not-closed polyline. Thats the origin of my having two subs Shape_1 and Shape_2. They differ only by whether they close the polyline at the end. I preload 4 variables A,B,C,D, and W which I use for thickness, but if they are not needed, zeros can be passed.

Since this is a spreadsheet, not an actual database, our records can have a variable number of columns, we can skip lines, we can have sections of closed and not closed parts. The only requirement is that the key column contains the name of the part.

Different parts drawn with shape_ID and parameters.

Sub test2_sheet()
    Call init_draw
    Dim A As Double, B As Double, C As Double, D As Double, W As Double
    Dim shape_ID As String
    
    A = 2
    B = 4.25
    C = 0
    D = 0
    W = 0.0625
    
    shape_ID = "OSCF"
    
    ' shape_ID = "ISCF"
    ' shape_ID = "CAP"
    ' shape_ID = "FLOOR"
    'shape_ID = "FLAT"
    'shape_ID = "JCHAN"
    'shape_ID = "HANG"
     
    Call shape_2(shape_ID, A, B, C, D, W)
    
    pt1 = pt(4, 4, 0)
    g_pline.Move pt0, pt1
    
End Sub

Assemblies drawn using global polyline methods move, rotate, mirror


Sub test1_sheet()
    Call init_draw
 
    Call shape_2("box", 34, 0.0625, 0, 0, 0)
    
    Call shape_2("box", 34, 0.0625, 0, 0, 0)
    g_pline.Move pt0, pt(0, 3.9375, 0)
    
     Call shape_2("box", 1, 3.875, 0, 0, 0)
     g_pline.Move pt0, pt(0, 0.0625, 0)
    
    Call shape_2("box", 1, 3.875, 0, 0, 0)
     g_pline.Move pt0, pt(33, 0.0625, 0)
     
  acadApp.Update
End Sub

More complex assemblies can use a selection set to block the result using parameters in the name. So its pretty easy to develop a lot of similar parts with different dimensions.

Sub part_end_view_2(W As Double, Thk As Double)
 
    Dim strblk As String
    strblk = "Panel " & Thk & " x " & W - 1 & " GL"
     
    Call init_draw
    Dim sset As AcadSelectionSet
    addss "SSBLOCK"
    Set sset = acadDoc.SelectionSets.Item("SSBLOCK")
 
    Call shape_1("FM_SINGLE", W, 0, 0, 0, 0)
    sset.Select acSelectionSetLast

    g_pline.Mirror pt(0, Thk / 2, 0), pt(5, Thk / 2, 0)
    sset.Select acSelectionSetLast
  
    Call shape_1("CHAN_SINGLE", 1, Thk - 0.125, 0, 0, 0)
    g_pline.Move pt0, pt(0, -(Thk - 0.125) / 2, 0)
    g_pline.Rotate pt0, PI
    g_pline.Move pt0, pt(1.25, Thk / 2, 0)
    sset.Select acSelectionSetLast
  
    Call shape_1("CHAN_SINGLE", 1, Thk - 0.5, 0, 0, 0)
    g_pline.Move pt0, pt(0, (-(Thk - 0.5) / 2), 0)
    g_pline.Move pt0, pt(W - 1.25, Thk / 2, 0)
    sset.Select acSelectionSetLast
     
    make_blk sset, strblk
    sset.Erase
    sset.Clear
    sset.Delete
    acadDoc.ModelSpace.InsertBlock pt0, strblk, 1, 1, 1, 0
  
    acadApp.Update
End Sub

When rotating and moving, sometimes its conceptually easier to go backwards. What point is easiest to reference in the final position? Move the part so that point is at 0,0 then rotate about the origin and move from there. Or you can draw the object in the rotation and position you wish by experimenting with the point values in the spreadsheet.

I have found the Evaluate function in VBA is pretty robust and it doesnt matter whether all the spreadsheet entries have the proper spaces, A+W or A + W both are evaluated correctly.

EDIT:- a bug,

the code ran many times before this error popped up. When it does error, it seems to always be that Evaluate is trying to convert a string representing an integer to a double. Other integers work fine, 6 instead of a 4, input from a form, exact same code, CDBL does not seem to help. Variant does not help. something here i am not getting.

When errors make no sense, i tell people, re-boot.

the downside to sheet driven parts – besides sometimes it does not run – its conceptually simpler to see it in code. parameters in a sheet are more fragile, its much easier to delete data in a sheet than code. protect the sheet if you give it out.

on the other hand, I quickly made several assembly drawing programs using sheet driven parts.

this seems to get past the error, though it needs further looking at.

Dim dbl As Double

For i = 1 To icount
str = rng.Cells(1, i)
str = Replace(str, “A”, A)
str = Replace(str, “B”, B)
str = Replace(str, “C”, C)
str = Replace(str, “D”, D)
str = Replace(str, “W”, W)

On Error Resume Next
dbl = CDbl(Evaluate(str))

If Err Then
ar(i) = CDbl(str)
Err.Clear
Else
ar(i) = Evaluate(str)
End If

On Error GoTo 0

Next i

AddLine Absolute and Relative Variations

AddLine absolute and relative variations

Relative coordinates are conceptually the same thing as a vector. Given a start point, a line drawn to relative coordinates will be the start point plus the new vector added to it. Relative data looks the same and has the same structure as the absolute point, but the programming context differs. Our standard addline wrapper using absolute coordinates we will call Line1. Our addline wrapper using relative coordinates we will call Line2. It looks the same as Line1, but the first point is absolute, the second point is relative. The line is drawn from the first point to their sum. To get the full benefit of relative coordinates, the endpoint needs to be saved to a lastpoint type variable, I will call g_pt. This is similar to the way turtle geometry remembers its current position. We use sub Line2(abs pt, rel pt) where abs pt can be but does not have to be the current point. Both Line1 and Line2 save their endpoint as g_pt. With this system we can walk down a line of features drawing an item in sequence. To draw a line from any point to a point 5 units to the east, Line2 pt1, pt(5,0,0). To draw the next line 2 units up, Line2 g_pt, pt(0,2,0). pt(x,y,z) is a wrapper i have previously detailed.

Autocad has four basic ways of addressing the coordinate system, two for 2D and 2 for 3d. Each of these has an absolute and a relative method. The absolute mode references the origin, 0,0,0. The relative mode references the last point.

If you do not type the at sign, you are entering an absolute coordinate relative to the origin.
If you type an at sign, you are entering a coordinate relative to the starting point.

Start the line command, pick a random start point, the following options can be typed to draw different lines – All options have absolute and relative modes.

Cartesian coordinates
3,1
Draws a line from the startpoint to the absolute coordinate address defined by 0,0

@3,1
Draws a line to the right 3 and up 1 relative from the start point.

Polar coordinates
3<45
Draws a line from the startpoint to a point 3 units from the origin and at angle 45 from the zero angle line. The zero angle line is positive x, but of course it can be changed. angle zero is to the right, the east, and angles increment counter clockwise (< 90 is to top).

@3<45
Draws a line 3 units long at 45 degrees from the startpoint

These are the main methods for 2D drafting. The relative address can also be typed for the first prompt. Autocad uses the LastPoint variable, adds the relative address and uses that for the first point.

for 3D there are two more methods.

Cylindrical coordinates
3<45,4
The first part of the address is the same as polar coordinates, the second part raises the line to a point with Z = 4

@3<45,4
Draws a line with cylindrical coordinates relative from the startpoint at distance and angle, then to z dimension.

Spherical coordinates
3<45<30
Distance and angle same as polar coordinates, then an angle from the xy plane.
For instance, if a sphere the size of earth had its origin at its center, and if England were on the positive X axis, with the z-axis through the poles, the address for Moscow would be 3985<37<55, approximately, in miles. 3985 is the earth radius in miles. Latitude and Longitude use this system, though they use North South East West rather than plus minus.

@3<45<30 would use the starting point as the relative origin.

For completeness, a user should know direct distance entry, which accepts a number for distance and uses the cursor for direction.

Now lets look at autocad VBA addline. I wont do any 3D today. Addline uses absolute points. It has no built-in relative addressing, but its easy to add. Addline has only two arguments, two points.

Dim lineobj As AcadLine
Set lineobj = acadDoc.ModelSpace.AddLine (pt1, pt2)

If these are dynamic arrays, we have all kinds of options.

Rather than embed addline in our main code, the first thing we should do is make a convenient wrapper for it. We can forget the details if we do that. Lets call the basic addline wrapper with absolute point addresses Line1

 Sub line1(pt1() As Double, pt2() As Double, Optional strlayer As Variant)
   ' line wrapper absolute pt args with optional layer
    
        Dim lineobj As AcadLine
        Set lineobj = acadDoc.ModelSpace.AddLine(pt1, pt2)
            
        If Not IsMissing(strlayer) Then
           lineobj.Layer = strlayer
        End If
        
        g_pt = pt2
        Set g_line = lineobj
 End Sub

3 things are added above the minimum. An optional layer name in the arguments list and two global variables. G_pt is a dynamic array. It becomes the VBA version of LastPoint. G_line is a global acadline. All the properties and methods of the line just created are available in the calling program (including move). These dont have to be used but they are there.

Here is our current drawing project. We want to draw a notched plate for any length of plate and any center dimension on the half-slots. We have previously derived N and R, now we want to apply those numbers.

The easiest way to approach this is with a lastpoint variable that knows the endpoint of the last line is the beginning of the next line. To take advantage of that we also need relative coordinates. Line2 expects an absolute first point and a relative second point. It adds them to find the absolute lastpoint. At the end it saves the result to g_pt.

Sub line2(pt1() As Double, pt2() As Double)
  'vector method, line from pt1 startpoint at pt2 displacement
        Dim lineobj As AcadLine
        Dim pt3() As Double
        
        pt3 = pt(pt1(0) + pt2(0), pt1(1) + pt2(1), pt1(2) + pt2(2))
        Set lineobj = acadDoc.ModelSpace.AddLine(pt1, pt3)
 
         g_pt = pt3
         Set g_line = lineobj
 End Sub

In our example, the left end of the line is at 0,0. There are two horizontal lines, LineR and LineC. We need a loop. If we iterate the loop N times, there is one extra slot. So the pseudocode is

LineR
Half-slot
Loop n times
LineC
Half-slot
End loop
LineR

Line1 is sufficient for LineR and initializes g_pt as the starting point of the slot (pt function is explained in detail previously)

line1 pt0, pt(R – D / 2, 0, 0)

The sub half-slot uses g_pt as its starting point and the variables for the size of the slot. Line2 is used so that the line is drawn

from g_pt @ 0, gage

line2 g_pt, pt(0, gage, 0)

Now the arc has to be made. The VBA addarc takes four arguments, the center, radius, startangle and endangle. The arc is always drawn counterclockwise. I dont have anything fancy for it. It does not use endpoints. We have to calculate the center. The startangle is zero. The endangle is 180. We can use a degree to radian converter in the wrapper so we can feed it degrees. The startpoint actually is the point we want to save as our g_pt, so we need to calculate that. The original g_pt, the ctr and the ending g_pt are all in a line with the same y value. We just need to increment the x value. V_add is a function to add two points and return their sum. It stands for vector_add. The concept of vector addition to calculate points simplifies the code.

After we have the arc, we add the last line, the same as the first line except in the other direction. Everytime we draw anything, g_pt is updated so we can use it for our next starting point. Here is the code for the half_slot.

Sub half_slot(g_pt() As Double, gage As Double, dia As Double)
    Dim ptc() As Double
     
     'first vertical line with vector method
        line2 g_pt, pt(0, gage, 0)
    
    'calculate arc center with by adding vector to current point
    ptc = v_add(g_pt, pt(dia / 2, 0, 0))
    arc1 ptc, dia / 2, 0, 180
    
    'since arc doesnt work with points
    'the starting point for the next line has to be calculated
     g_pt = pt(g_pt(0) + dia, gage, 0)
    
    'second vertical line with vector method
    ' a variable cannot be negated with a negative sign
    ' have to subtract from zero
    line2 g_pt, pt(0, 0 - gage, 0)
End Sub

Here is the sub that draws the notched edge, given L, N, C and R

 Sub edge_slot(L As Double, N As Integer, C As Double, R As Double)
    'G = slot Gage - distance of center from edge
    'D = Dia of slot
       Dim G As Double, D As Double
       Dim i As Integer
       'read in globals
       G = hole_gage
       D = hole_dia

    'line R1
       line1 pt0, pt(R - D / 2, 0, 0)
    'half_slot prior to loop
       half_slot g_pt, G, D
    
    'loop draws horiz lineC and the half-slot
         'absolute coordinates in the loop are messy
         'line1 g_pt, pt(R + i * C - D / 2, 0, 0)
         'easier to figure the vector from the startpoint
      For i = 1 To N
          line2 g_pt, pt(C - D, 0, 0)
          half_slot g_pt, G, D
      Next i
    'line R2
        line1 g_pt, pt(L, 0, 0)
End Sub

Parametric Dimensioning

Sub-routines and functions should be single purpose, they should list inputs and outputs in comments at the top of the file, and they should print on one page. Thats what I learned at school. The sub that calculates parametric points though tends to turn into a long list of tasks because the point values are so useful. They are used to hang dimensions, notes, blocks, associate with other parts, move into position on the page, and on and on. Another thing sometimes making it difficult to break up the laundry list is that functions can only return one value.

Small pieces are easier to manage than one big. Irrelevant but necessary details are hidden. Compromises then are these. The calling sub we will call main (not literally). The polyline draw routine is a sub of main. Anything that does not require point values developed in the draw sub will sub from main. Anything that must use the point values in polyline draw can tack on to polyline draw or sub from it. Functions (actually subs) that need to set up more than one value can use global variables. Global variables are a useful tool.

Dimensions hang from the points of the object. It’s hard to remove the dimension sub from the geometry sub entirely, but they can be reduced to the essential. One of the complications of dimensioning parts that can change size is locating the dimensions. They have to move with the part. A big part of this post is showing how to do that. The array of geometry points can be searched in a loop to get a bounding box, then standard distances off the bounding box can be calculated for locating dimension lines.

To illustrate how dimensions work – the part is outside corner, abbrev OS_CRNR

The xy data are calculated from the sketch. The array is made. The array is passed off to be drawn.

Dim pts As Variant

x0 = 0
x1 = W
x2 = W + B – 0.375
x3 = W + B
x4 = x2
x5 = 0.125
x6 = 0.125 + W

y0 = 0
y1 = W
y2 = W + A – 0.375
y3 = W + A
y4 = y2
y5 = 0.125
y6 = 0.125 + W

pts = Array(x0, y0, x2, y0, x3, y5, x3, y6, x4, y1, x1, y1, x1, y4, x6, y3, x5, y3, x0, y2)
Call draw_array(pts)

bound_box pts
dimloc LL, UR, sc

The array can then be traversed to find its minimum and maximum values, and a bounding box, defined by lower left point and upper right point, can be calculated. Since there are two values to be returned, global variables are used.

Public LL() As Double
Public UR() As Double


Sub bound_box(pts)
'input is variant array of pts created for 2D polyline
'output is global LL and UR points of bounding box
     Dim i As Integer
     Dim lower As Integer, upper As Integer
     Dim xmin As Double, xmax As Double
     Dim ymin As Double, ymax As Double
     
     lower = LBound(pts)
     upper = UBound(pts)
     
     xmin = pts(0)
     xmax = pts(0)
          
     For i = 0 To upper - 1 Step 2
     If xmin > pts(i) Then xmin = pts(i)
     If xmax < pts(i) Then xmax = pts(i)
     Next i
 
     ymin = pts(1)
     ymax = pts(1)
     
     For i = 1 To upper Step 2
     If ymin > pts(i) Then ymin = pts(i)
     If ymax < pts(i) Then ymax = pts(i)
     Next i
     
     'global pt variables set
     LL = pt(xmin, ymin, 0)
     UR = pt(xmax, ymax, 0)

End Sub

Now that the corners of a virtual box are obtained, it can be used to situate dimension lines. These have to be calculated in relation to whatever scale is used. Thats a separate determination in the program. Here I am using global variable sc which is set to 2. The distance between dimension lines is one half inch. Those two numbers are multiplied.

Linear Dimensions in autocad vba need three inputs – two endpoints and a location for the dimension line. We are making standard locations on all 4 sides for the dimension lines. They are global variables. They are our common dynamic point array. They are calculated a set distance from the part and almost never have to be moved after the fact.

Bound_box returns the extents of the part. The sub dimloc uses the extents for input, LL and UR, and the scale sc and sets the location variables for this particular part.


Sub dimloc(LL() As Double, UR() As Double, sc As Integer)
'input is lower and upper corner points of geometry
'output are global midpoint locations of dimension lines
' VT1, VT2, VT3, VT4, HZ1, HZ2, HZ3, HZ4
     
    Dim x As Double, y As Double
    Dim A As Double
    A = 0.5 * sc
     
    x = (LL(0) + UR(0)) / 2
    y = LL(1) - A * 2
    hz1 = pt(x, y, 0)
     
    y = LL(1) - A
    hz2 = pt(x, y, 0)
    
    y = UR(1) + A
    hz3 = pt(x, y, 0)
    
    y = UR(1) + 2 * A
    hz4 = pt(x, y, 0)
    
    
    x = LL(0) - A * 2
    y = (LL(1) + UR(1)) / 2
    vt1 = pt(x, y, 0)
    
    x = LL(0) - A
    vt2 = pt(x, y, 0)
    
    x = UR(0) + A
    vt3 = pt(x, y, 0)
    
    x = UR(0) + 2 * A
    vt4 = pt(x, y, 0)
      
      
     LL2 = pt(vt1(0), hz1(1), 0)
     UR2 = pt(vt4(0), hz4(1), 0)

End Sub

And then finally we use those variables to create dimensions. We do that in the sub where the points are using the xy data available. The call is simple, the details are hidden away. Wrapper subs for the dimension are used. I use one for each vertical and horizontal dimensions with the rotations built-in.

Here is the calling sub OS_CRNR (main), OS_CRNR_draw, and the dimensioning wrappers.


Sub OS_CRNR(A As Double, B As Double, W As Double)
 
Call OS_CRNR_draw(A, B, W)
           do_os_crnr_note
           flat_dim = A + B
           Do_bend_det
           Do_border
           Do_title

           Etc
           Etc
  End Sub


 Sub OS_CRNR_draw(A As Double, B As Double, W As Double)
    Dim x0 As Double, y0 As Double
    Dim x1 As Double, x2 As Double, x3 As Double, x4 As Double, x5 As Double, x6 As Double
    Dim y1 As Double, y2 As Double, y3 As Double, y4 As Double, y5 As Double, y6 As Double
    Dim pts As Variant

    x0 = 0
    x1 = W
    x2 = W + B - 0.375
    x3 = W + B
    x4 = x2
    x5 = 0.125
    x6 = 0.125 + W
    
    y0 = 0
    y1 = W
    y2 = W + A - 0.375
    y3 = W + A
    y4 = y2
    y5 = 0.125
    y6 = 0.125 + W

    pts = Array(x0, y0, x2, y0, x3, y5, x3, y6, x4, y1, x1, y1, x1, y4, x6, y3, x5, y3, x0, y2)
    Call draw_array(pts)
    global_pline.Layer = "0"
    
    bound_box pts
    dimloc LL, UR, sc
    
    pt1 = pt(x1, y1, 0)
    pt2 = pt(x5, y3, 0)
    pt3 = pt(x3, y5, 0)
    pt4 = pt(x0, y3 - 0.625, 0)
    pt5 = pt(x3 - 0.625, y0, 0)
    
    dimv pt1, pt2, vt1
    dimh pt1, pt3, hz1
    dimv pt4, pt2, vt2
    dimh pt5, pt3, hz2

    do_screw pt4, 0
    do_screw pt5, PI / 2

    acadApp.Update
End Sub


Sub dimv(pt1() As Double, pt2() As Double, dimlocpt() As Double)
 Dim dimObj As AcadDimRotated
 Set dimObj = acadDoc.ModelSpace.AddDimRotated(pt1, pt2, dimlocpt, PI / 2)
 dimObj.Layer = "DIM"
End Sub


Sub dimh(pt1() As Double, pt2() As Double, dimlocpt() As Double)
 Dim dimObj As AcadDimRotated
 Set dimObj = acadDoc.ModelSpace.AddDimRotated(pt1, pt2, dimlocpt, 0)
 dimObj.Layer = "DIM"
End Sub

see the previous post for the essential PT(x,y,z) function that creates point arrays.

global variables that dimloc sets look like this (below). LL2 and UR2 are bounding box of the part and its dimensions, for the purpose of moving it into position on a 8×10 border. I have made peace with the idea that there can be too many global variables. They help solve the problem of passing values between smaller programs.

‘vert dim line locations left to right
Public vt1() As Double
Public vt2() As Double
Public vt3() As Double
Public vt4() As Double

‘horiz dim line locations bottom to top
Public hz1() As Double
Public hz2() As Double
Public hz3() As Double
Public hz4() As Double

Public LL() As Double
Public UR() As Double

Public LL2() As Double
Public UR2() As Double