Planes

Autocad has a point, a line, but no plane object. The Region object works fine.

AddRegion takes an array of autocad entities which must be a closed figure. This would make a triangle.

Sub plane_3pt(pt1() As Double, pt2() As Double, pt3() As Double)
 Dim lines(0 To 2) As AcadEntity

 Set lines(0) = line1(pt1, pt2)
 Set lines(1) = line1(pt2, pt3)
 Set lines(2) = line1(pt3, pt1)

 Dim regionobj As Variant
 regionobj = acadDoc.ModelSpace.AddRegion(lines)
 regionobj(0).EntityTransparency = 90

End Sub

in this sub to make a region from 4 pts i added an optional layer argument and a global variable to control transparency. To view a region you have to change the autocad visual style to anything except 2D Wireframe.

Sub plane_4pt(pt1() As Double, pt2() As Double, pt3() As Double, pt4() As Double, Optional strlayer As Variant)
 Dim lines(0 To 3) As AcadEntity

 Set lines(0) = line1(pt1, pt2)
 Set lines(1) = line1(pt2, pt3)
 Set lines(2) = line1(pt3, pt4)
 Set lines(3) = line1(pt4, pt1)

 Dim regionobj As Variant
 regionobj = acadDoc.ModelSpace.AddRegion(lines)
 regionobj(0).EntityTransparency = g_transparency

    If Not IsMissing(strlayer) Then
       regionobj(0).Layer = strlayer
    End If

End Sub

you can pass a polyline. it has to be a 3D polyline. if you do that, the array only needs one slot. You cannot pass the polyline directly to AddRegion

Sub plane_pl(pline As Acad3DPolyline, Optional strlayer As Variant)

Dim lines(0) As AcadEntity
Set lines(0) = pline

Dim regionobj As Variant
regionobj = acadDoc.ModelSpace.AddRegion(lines)
regionobj(0).EntityTransparency = g_transparency

    If Not IsMissing(strlayer) Then
       regionobj(0).Layer = strlayer
    End If

End Sub

a simple equation such as x=3 is a line in 2D space, but its a plane in 3D space.

this is the test code to create planes setting x = 1,2,3,4,5,6,7,8,9 and setting a layer with the same name and color.

init sets up the min and max for y and Z . I shouldnt run a loop counter with a double, but it didnt cause any trouble. my pt sub that creates point arrays expects a double.

Sub test_plane5()
  init
  Dim x As Double

    For x = 1 To 9
        pt1 = pt(x, ymin, zmin)
        pt2 = pt(x, ymax, zmin)
        pt3 = pt(x, ymax, zmax)
        pt4 = pt(x, ymin, zmax)
        
        plane_4pt pt1, pt2, pt3, pt4, x
    Next x
  Update
End Sub

to make 3D polylines to use in region making, i use an old sub i use for drawing 2D profiles, modified for 3D. its a little more complicated looking, but the purpose of it is to be able to make the point array with the VBA ARRAY statement. unfortunately autocad VBA Add3DPoly does not accept this array so it has to be copied to an array of doubles.

pts = Array(x, y1, z1, x, y1, z2, x, y2, z2, x, y2, z1)

this can be any number of points, the receiving sub counts the index numbers and sets up a for loop to copy.

here are 3 subs to draw planes parallel to the coordinate planes using this method.

Sub test_plane8()
  init
  
  xplane 2, "1"
  yplane 1, "2"
  zplane -2, "3"

  Update
End Sub


Sub xplane(x As Double, strlayer As String)
  Dim y1 As Double, y2 As Double
  Dim z1 As Double, z2 As Double
  Dim pts As Variant
    
  y1 = ymin: y2 = ymax
  z1 = zmin: z2 = zmax

      pts = Array(x, y1, z1, x, y1, z2, x, y2, z2, x, y2, z1)
      Call draw_3D_array(pts)
      plane_pl g_3D_pline, strlayer
End Sub

Sub yplane(y As Double, strlayer As String)
  Dim x1 As Double, x2 As Double
  Dim z1 As Double, z2 As Double
  Dim pts As Variant
    
  x1 = xmin: x2 = xmax
  z1 = zmin: z2 = zmax

      pts = Array(x1, y, z1, x1, y, z2, x2, y, z2, x2, y, z1)
      Call draw_3D_array(pts)
      plane_pl g_3D_pline, strlayer
End Sub

Sub zplane(z As Double, strlayer As String)
  Dim x1 As Double, x2 As Double
  Dim y1 As Double, y2 As Double
  Dim pts As Variant
    
  x1 = xmin: x2 = xmax
  y1 = zmin: y2 = zmax

      pts = Array(x1, y1, z, x1, y2, z, x2, y2, z, x2, y1, z)
      Call draw_3D_array(pts)
      plane_pl g_3D_pline, strlayer
End Sub


Sub draw_3D_array(ar As Variant)
     Dim pts() As Double
     Dim i As Integer
     Dim lower As Integer, upper As Integer
     lower = LBound(ar)
     upper = UBound(ar)
     
     ReDim pts(lower To upper)
     For i = lower To upper
     pts(i) = ar(i)
     Next i
         
         Set g_3D_pline = acadDoc.ModelSpace.Add3DPoly(pts)
         g_3D_pline.Closed = True
         g_3D_pline.Update
End Sub

Sub plane_pl(pline As Acad3DPolyline, Optional strlayer As Variant)
 Dim lines(0) As AcadEntity
 Set lines(0) = pline

 Dim regionobj As Variant
 regionobj = acadDoc.ModelSpace.AddRegion(lines)
 regionobj(0).EntityTransparency = g_transparency

    If Not IsMissing(strlayer) Then
       regionobj(0).Layer = strlayer
    End If
End Sub

in 2D space, the standard equation of a line is

Ax + By + D = 0

in 3D space, this is a plane.

the standard equation of a plane in 3D space is

Ax + By + Cz + D = 0

if C is zero, the plane is parallel to the Z axis.

the equation can be rewritten to

Y = -A/B * X – D/B


Sub test_plane9()
  init

  xyplane -4, 2, 2, "4"
  xyplane 3, 2, -2, "5"
      
  Update
End Sub


Sub xyplane(A As Double, B As Double, D As Double, strlayer As String)
  Dim x1 As Double, x2 As Double
  Dim y1 As Double, y2 As Double
  Dim z1 As Double, z2 As Double
  Dim pts As Variant
    
  z1 = zmin: z2 = zmax
  x1 = xmin: x2 = xmax

  y1 = -A / B * x1 - (D / B)
  y2 = -A / B * x2 - (D / B)

      pts = Array(x1, y1, z1, x2, y2, z1, x2, y2, z2, x1, y1, z2)
      Call draw_3D_array(pts)
      plane_pl g_3D_pline, strlayer
End Sub

if you are not seeing transparency, there is a variable that disables it.

set TRANSPARENCYDISPLAY to 1

another variable DELOBJ deletes the defining lines when the Region is made. it works if the Region is made manually, but does not seem to work when the Region is made in code.

remember, set Visual Style not to 2D wireframe

A little Problem with Arrowheads

we will get to that later.

Plotting a plane

Ax + By + Cz + D = 0

difficult to see in a single view.
using arbitrary values, A=2 B=3 C=4 D=5

a plane is defined by 3 points, but the equation for a plane is derived from a single point and the direction numbers for a 3D line that is perpendicular to the plane. so given the equation for a plane, find at least 3 points in the plane.

we can set any 2 of the 3 variables xyz to zero and solve for the third to get 3 points where the plane intercepts the axes.

(-D/A, 0, 0)
(0, -D/B, 0)
(0, 0, -D/C)

we can set one variable to zero and solve to get an equation for a 2D line in the coordinate axis plane, then choose reasonable numbers for the minimum and maximum of the dependent variable.

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. 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 could use actual data to prove it for this one specific case, but not a general vector equation. i believe solution lies with the similarity of triangles – the projection of AB on BC at P is the same as the projection of BH on BC at P, so that AB dot BC is equal to BH dot BC. and the same argument for AB on AC. In lieu of that, i show the drawing of the figure in autocad VBA.

The triangle vertexes are given. The altitude starts at a vertex. It terminates at a right angle to the other side, which has known endpoints and hence a known slope. The slope of the altitude is the negative inverse of the slope of the line it meets. Autocad has a method to determine an intersection between two drawing objects, called InterSectWith. I use it twice, once to find the orthocenter intersection of altitudes point H, then to find the intersection with the far side.

First the line is drawn from the vertex using the slope and an arbitrary length. That establishes actual autocad entities to use with the InterSectWith method. I draw all lines with a function that returns a line object, and once the proper endpoint is found, its easy to change the endpoint property of the line.

slope = tan theta = delta y / delta x

Slope and tangent work with undirected lines. On the graph, its the angle the line makes with the positive x axis from -90 to +90. Given the slope as a simple number, we have lost the ability to know what quadrant the coordinates were in. If you wanted to draw vectors, you would have to analyze the x and y values independently. I dont worry about that here. If the line is drawn the wrong way, I change the length of its sign. The bottom line is that slope and tangent work with the same set of angles, and to find the angle from the slope, use the arctangent function ATN.

theta = ATN (slope)

See the function for line3 which accepts a startpoint, a slope and a length to draw a line.

code after the picture


Sub test7()
'5 p30 altitude of triangle from vertex to perpendicular
   init
   'orthocenter
   Dim ptH() As Double
   'lines
   Dim AB As AcadLine, BC As AcadLine, CA As AcadLine
   Dim AP As AcadLine, BQ As AcadLine, CR As AcadLine
   'slopes
   Dim m_AB As Double, m_BC As Double, m_CA As Double
   'points
   Dim ptA() As Double, ptB() As Double, ptC() As Double
   Dim ptP() As Double, ptQ() As Double, ptR() As Double
          
   ptA = pt(2, 1, 0)
   ptB = pt(9, 3, 0)
   ptC = pt(3, 6, 0)
   
   Set AB = line1(ptA, ptB)
   Set BC = line1(ptB, ptC)
   Set CA = line1(ptC, ptA)
   
   m_AB = slope(ptA, ptB)
   m_BC = slope(ptB, ptC)
   m_CA = slope(ptC, ptA)
      
   Set AP = line3(ptA, (-1 / m_BC), 5)
   Set BQ = line3(ptB, (-1 / m_CA), -5)
   Set CR = line3(ptC, (-1 / m_AB), -5)
       
   ptH = intersectWith(AP, BQ)
    
    AP.EndPoint = ptH
    BQ.EndPoint = ptH
    CR.EndPoint = ptH
        
   ' txt1 "A", ptA, 0.375
   ' txt1 "B", ptB, 0.375
   ' txt1 "C", ptC, 0.375
   ' txt1 "H", ptH, 0.375
    
    ptP = intersectWith(AP, BC)
    ptQ = intersectWith(BQ, CA)
    ptR = intersectWith(CR, AB)
         
    AP.EndPoint = ptP
    BQ.EndPoint = ptQ
    CR.EndPoint = ptR
       
   Update
End Sub

Function line1(startpt() As Double, endpt() As Double, Optional strlayer As Variant) As AcadLine
    Set line1 = acadDoc.ModelSpace.AddLine(startpt, endpt)
        
    If Not IsMissing(strlayer) Then
       line1.Layer = strlayer
    End If
         
    g_pt = endpt
  End Function

  Function line3(pt1() As Double, slope As Double, leng As Double) As AcadLine
    Dim pt2() As Double, theta As Double
     theta = Atn(slope)
    
     pt2 = acadDoc.Utility.PolarPoint(pt1, theta, leng)
     Set line3 = acadDoc.ModelSpace.AddLine(pt1, pt2)
    
     g_pt = pt2
  End Function

Function slope(pt1() As Double, pt2() As Double) As Double
     Dim x As Double, y As Double, z As Double
     y = pt2(1) - pt1(1)
     x = pt2(0) - pt1(0)
    
    If x = 0 Then
    MsgBox "div by zero in slope"
    Exit Function
    Else
    slope = y / x
    End If

End Function

  Function intersectWith(L1 As AcadLine, L2 As AcadLine) As Double()
    Dim ptH(0 To 2) As Double
    Dim intpoints As Variant
    
    intpoints = L1.intersectWith(L2, acExtendBoth)
   
    ' copied changed from autocad activex help for Intersectwith
    Dim I As Integer, j As Integer
     
    If VarType(intpoints) <> vbEmpty Then
        For I = LBound(intpoints) To UBound(intpoints)
             
            ptH(0) = intpoints(j)
            ptH(1) = intpoints(j + 1)
            ptH(2) = intpoints(j + 2)
                        
            I = I + 2
            j = j + 3
        Next
     Else
        MsgBox "did not find intersect"
     End If

    intersectWith = ptH

End Function

Prove the perpendicular bisectors of a triangle are concurrent. The point K is called the circumcenter. A circle with center at K passes through the vertexes.

code to draw (not prove) after the picture


Sub test8()
'6 p30 perpendicular bisector of 3 sides of triangle are concurrent
  init
   
   'circumcenter
   Dim ptK() As Double
   'lines
   Dim AB As AcadLine, BC As AcadLine, CA As AcadLine
   Dim PK As AcadLine, QK As AcadLine, RK As AcadLine
   'slopes
   Dim m_AB As Double, m_BC As Double, m_CA As Double
   'points
   Dim ptA() As Double, ptB() As Double, ptC() As Double
   Dim ptP() As Double, ptQ() As Double, ptR() As Double

   ptA = pt(2, 1, 0)
   ptB = pt(9, 3, 0)
   ptC = pt(3, 6, 0)
   
   Set AB = line1(ptA, ptB)
   Set BC = line1(ptB, ptC)
   Set CA = line1(ptC, ptA)
   
   m_AB = slope(ptA, ptB)
   m_BC = slope(ptB, ptC)
   m_CA = slope(ptC, ptA)
   
   ptP = midpoint(ptB, ptC)
   ptQ = midpoint(ptC, ptA)
   ptR = midpoint(ptA, ptB)
      
   Set PK = line3(ptP, (-1 / m_BC), 5)
   Set QK = line3(ptQ, (-1 / m_CA), -5)
   Set RK = line3(ptR, (-1 / m_AB), -5)

   ptK = intersectWith(PK, QK)
    PK.EndPoint = ptK
    QK.EndPoint = ptK
    RK.EndPoint = ptK

   Update
End Sub

finally, another unfinished project, prove the lines joining the midpoints of a quadrilateral bisect each other.


Sub test10()
'8 p30 lines joining midpoints of opposite sides of a quadrilateral bisect each other
  init
   
   Dim ptZ() As Double
   'lines
   Dim AB As AcadLine, BC As AcadLine, CD As AcadLine, DA As AcadLine
   Dim PR As AcadLine, QS As AcadLine
   
   Dim ptA() As Double, ptB() As Double, ptC() As Double, ptD() As Double
   Dim ptP() As Double, ptQ() As Double, ptR() As Double, ptS() As Double
   
   ptA = pt(2, 8, 0)
   ptB = pt(10, 7, 0)
   ptC = pt(12, 2, 0)
   ptD = pt(1, 3, 0)
   
   Set AB = line1(ptA, ptB)
   Set BC = line1(ptB, ptC)
   Set CD = line1(ptC, ptD)
   Set DA = line1(ptD, ptA)
    
   ptP = midpoint(ptA, ptB)
   ptQ = midpoint(ptB, ptC)
   ptR = midpoint(ptC, ptD)
   ptS = midpoint(ptD, ptA)
   
   Set PR = line1(ptP, ptR)
   Set QS = line1(ptQ, ptS)
    
    txt1 "A", ptA, 0.375
    txt1 "B", ptB, 0.375
    txt1 "C", ptC, 0.375
    txt1 "D", ptD, 0.375
   
    txt1 "P", ptP, 0.375
    txt1 "Q", ptQ, 0.375
    txt1 "R", ptR, 0.375
    txt1 "S", ptS, 0.375
    
    ptZ = intersectWith(PR, QS)
    txt1 "Z", ptZ, 0.375
 
   Update
End Sub

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

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"
''
''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

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

Approximating the Circle

Drawing Circles the Hard Way – with Straight Lines

Our turtle has a local viewpoint. He can draw a line one unit, turn one degree, then repeat that 360 times, coming back around where he started, but at no time is a center or radius known, even though the approximate circle has both. By measuring the drawn approximate circle or by doing a little math the radius can be found. The circumference is total direction traveled. Using the formula Circum = pi*(Dia) and substituting 360 for the Circum the radius is found to be 180 / pi or approx 57.3.

If we make the subroutine more general to accept as input the angle turned between each line and the length of the lines, we no longer have a loop of 360 and we need to calculate the number of lines to draw.

num_lines = 360 / angle

will give a full circle (as long as angle is a multiple of 360). With this sub we can experiment with varying angles and line lengths and see how the radius changes. Using 1 and 1 gives the same results as before, but also using any two numbers that are the same, such as 10 and 10, give a circle (more or less) with the same radius as 1 and 1. Using different numbers for angle and line length will make the circle diameter change as a direct proportion of the ratio

len_lines / ang.

Longer lines will give larger diameters. Larger angles will give smaller diameters.

We can see by experimentation that every ratio of line_length to angle has a definite radius, so lets find that equation.
We already needed an equation between num_lines and ang, which was num_lines = 360 / ang. If for instance we turned 120 degrees with each turn, we would only need 3 lines and our approximate circle would be a triangle. If we turn one degree, we need 360 lines.

We also used the fact that 360 lines of one unit had a circumference of 360. No matter how many lines of whatever length,
the circumference is num_lines * len_lines.

C= (num_lines) * (len_lines) and into that we substitute our calculation num_lines = 360 / ang.

C = (360 / ang) * (len_lines)

Circumference of course is 2 pi R
2 pi R = (360/ang) * len_lines
R = (180/ang) * (len_lines/pi)

R = (180/pi) * (len_lines/ang)

and there is our ratio of line length to ang as a direct proportion to R.

Don’t forget, like I did when measuring the radius of a polygon, this radius is calculated by adding the straight line lengths and calculating the radius of a circle of that circumference. If the straight line approximation is crude, the radius will be crude. The more lines used to approximate the circle, the better the radius calculated from them.

R and ang can be switched with a little algebra to find ang.

ang = (180 / pi) * ( len_lines / R)

and now we can re-write our sub-routine so it accepts the radius and len_lines as argument and calculates the angle to turn each line and the number of lines to close (or almost close) the circle.

Finally having written a general program to draw circles of a given radius using straight lines of a given length, drawing an arc of given degree is just reducing the number of lines drawn by the same ratio as arc degrees to 360.

for a circle
num_lines = 360 / ang

for an arc with deg as the new input
num_lines = 360 / ang
num_lines = (deg / 360) * num_lines

but more simply this is
num_lines = deg / ang

Turtle Basic 2019

Turtle Basic 2019

A very useful, advanced, early book is “Turtle Geometry” by Harold Abelson and Andrea diSessa, two MIT scientists, published in 1980. The MIT group had been working 10 years or more at that time with Turtle geometry, Logo and Lisp. The book is written with emphasis on the mathematical ideas, not any specific implementation. The ideas are just as valid now as then. We can use their substantial, challenging concepts and implement them 40 years later. Our examples can go beyond what they show, because our tools are so much better.

I am doing a turtle graphics implementation using Autocad, creating a turtle class in excel VBA. Excel is simply providing the VBA editor. The principles and code would would work just as well in dot net, and identically in vba native in autocad or bricscad.

Position and Heading are the two basic turtle properties. Heading will be in degrees, between 0 and 360, not including 360. VBA and autocad demand radians. Our subs will do the conversion. Position consists of variables X and Y (and Z when the turtle sprouts wings some day). We will use type Double for all.

Class variables are either Private or Public. If a variable is Public it can be set directly. That should do for X and Y. If Heading is public, then Turtle.Heading = 361 is possible. We want to convert values to between 0 and 359.99. Get and Let manage Private class variables. These can be named anything you want but they cannot have the same name as the variable they control.

Basic turtle commands are FORWARD #, BACK #, RIGHT # and LEFT #. These are methods or procedures that change Position or Heading properties. PENUP and PENDOWN change a boolean PEN variable.

In a Class Module, not a standard code module –

Public x1 As Double
Public y1 As Double
Public x2 As Double
Public y2 As Double
Private pheading As Double
Public pen As Boolean

Current Position is x1, y1. The other endpoint of the line the turtle is going to draw is x2, y2. The heading is private. All others are public.

Insert Procedure Property from the VBA pulldown will insert a stub procedure to get a start on controlling a private variable. These normally have the same name. You would use the same name to read and write, which is how every property works. But lets use Heading for the read property and SetHeading for the write property. So instead of something like

Turtle1.heading = turtle1.heading + 45

We have

Turtle1.setheading = turtle1.heading + 45

In the class module is the Let, the Get, and the convertang function. The only way to set the Heading is thru Let which converts every angle to a value between 0 and 360, no matter how many consecutive turns or negative values added.

Public Property Get heading() As Double
heading = pheading
End Property

Public Property Let setheading(ByVal ang As Double)
pheading = convertang(ang)
End Property

wordpress is really hard to deal with, it thinks these inequality signs are html tags

The basic line drawing function is FORWARD #. Position and Heading are known. The only value required is distance. The other end of the line, x2, y2, has to be calculated with Cos and Sin, which require radians, not degrees. The value of the Pen boolean is checked to see if the line is to be drawn. The line is drawn with normal autocad vba methods. Finally the endpoint x2,y2 is made the new current position.

Public Sub forward(dist As Double)
'assumes x1 y1 and heading
x2 = x1 + dist * Cos(ang2rad(pheading))
y2 = y1 + dist * Sin(ang2rad(pheading))

If pen Then
Call drawline(x1, y1, x2, y2)
End If

'updates to new position
x1 = x2
y1 = y2
End Sub

 Sub drawline(x1 As Double, y1 As Double, x2 As Double, y2 As Double)
'internal sub to draw line
Dim acadline As acadline
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
pt1(0) = x1: pt1(1) = y1: pt1(2) = 0
pt2(0) = x2: pt2(1) = y2: pt2(2) = 0

Set acadline = acadDoc.ModelSpace.AddLine(pt1, pt2)

Update
End Sub

Since this is autocad, or something very much like it, we could definitely have turtle properties for line width, color and type. But we will save those for later.

Back is the same as Forward, except we add 180 to the direction, but we do not change the Heading variable.

x2 = x1 + dist * Cos(ang2rad(pheading + 180))
y2 = y1 + dist * Sin(ang2rad(pheading + 180))

Changing Heading with Left # and Right #

Public Sub left(ang As Double)
setheading = pheading + ang
End Sub

Public Sub right(ang As Double)
setheading = pheading - ang
End Sub

The degree to radian utility and Penup / Pendown

Function ang2rad(ang As Double) As Double
ang2rad = ang * Pi / 180
End Function

Public Sub penup()
pen = False
End Sub

Public Sub pendown()
pen = True
End Sub

In a standard code module, the class has to be instantiated, that means a new specific turtle object has to be created using the class template. If CTurtle is the name of the class module, then –

Dim turtle1 As CTurtle
Set turtle1 = New CTurtle

The variables are set with default value zero, so that debug.print turtle1.x1 would print 0. In the class module you can set initial values.

Private Sub Class_Initialize()
pen = True
pheading = 90 'traditional turtle direction
End Sub

To begin drawing, lets start with a basic polygon. An interior angle of an equilateral triangle is 60 degrees. The exterior angle is 120 degrees. The exterior angle is the angle you would turn if you were walking the lines of the triangle. Its the continuation of the line you are on past the vertex onto the next line. Its “how much the turtle must turn in drawing the vertex” (p.7 – Abelson).

Sub turtle_triangle()
connect_acad
Dim i As Integer
Dim turtle As CTurtle
Set turtle = New CTurtle
turtle.setheading = 60

For i = 1 To 3
turtle.fd 10
turtle.right 120
Next i

End Sub

In practice to save a little typing, I will do some of the declarations in public and subs.

Sub turtle_triangle()
init_turtle
turtle1.setheading = 60

For i = 1 To 3
turtle1.fd 10
turtle1.right 120
Next i

End Sub

To generalize a polygon, the total exterior angles sum up to 360 – the turtle makes one full turn to come back to its initial heading. The simplest polygon, or N-gon where N stands for number of sides, would have one degree turns and have 360 sides.

 Sub turtle_polygon(num_sides As Integer, angle As Double, len_side As Double)
init_turtle

For i = 1 To num_sides
turtle1.fd len_side
turtle1.right angle
Next i

End Sub

This has to be called by something with arguments. You have to know what the arguments are to get good regular polygons. I am sticking with double as type for angle, not integer. Num_sides has to be integer, because a half side is not realistic, and also num_sides is used as a counter in a for loop. A double actually would run there without error, but sooner or later you would miss your expected result by one item due to a rounding error.

Here is a demo which makes a variety of polygons.

Sub polygon_demo()
turtle_polygon 3, 120, 1
turtle_polygon 4, 90, 2
turtle_polygon 5, 72, 3
turtle_polygon 6, 60, 4
turtle_polygon 7, (360 / 7), 5
turtle_polygon 8, 45, 6
turtle_polygon 9, 40, 7
turtle_polygon 10, 36, 8
turtle_polygon 11, (360 / 11), 9
turtle_polygon 12, 30, 10
End Sub

Given the number of sides, and given the fact that the exterior angles always add up to 360, the turn angle is just 360 / num_sides. In the case of 7 and 11 sides, the angle is not an integer. Its a repeating decimal. I let vba calculate the number and feed whatever precision it wants to autocad, and it closes the polygon fine.

Since the angle is calculated we could put that into the sub and take it out of the arguments list. We could do it the other way, calculate the number of sides from the angle, but thats trickier because num_sides is an integer and we might not always get an integer from a division.

So we can calculate angle, take it out of the argument list, and get exactly the same results.

Sub turtle_polygon2(num_sides As Integer, len_side As Double)
init_turtle
Dim angle As Double
angle = 360 / num_sides

For i = 1 To num_sides
turtle1.fd len_side
turtle1.right angle
Next i
End Sub

But what about this idea of knowing the angle and not knowing the number of sides? The polygon is done when the turtle turns exactly 360 degrees. If the angle is a double though, some angles are not multiples of 360. If we are not going to control the loop with the number of sides as a counter, we need a way to stop when the turtle returns to its original heading and an emergency stop in case it never does. Using doubles for heading, there is no guarantee it will ever exactly be 360 degrees once it starts, due to double rounding imprecision.

Here is a Do Loop where the test is at the end of the loop, so heading starts out zero, or whatever, it adds one increment, then it checks before running the loop again. In addition I have an emergency counter to stay out of an infinite loop. The parameters are length of the side and angle. No opinion expressed about how many sides there will be. In practice it turns out and is logical, if the angle is an integer, the maximum number of sides will be 360.

Angle 45 should give us an octagon, and it does, with 8 lines.

Sub do_poly2()
connect_acad
Set turtle1 = New CTurtle
poly_demo2 1, 45
End Sub

90 gives a square, 120 a triangle, 36 gives a 10-gon. What if I try to draw a 7-gon? First lets let VBA do the math.

poly_demo2 1, (360 / 7)

Looks like it works fine, but when I list all the lines, I get 201 (or whatever my max counter is). They are on top of one another, I dont see any separation, I dont see any difference in the listing, 8 decimal places, but there is a difference out there somewhere. It looks like a septagon. It appeared to work before because we were controlling the number of sides, and here we are not.

We knew there would be non-closing figures. Any angle, integer or not, that is not a multiple of 360 is not going to give a closed polygon. For any angle that is a multiple of 360 we get a simple convex polygon. Some angles are not multiple of 360 but a multiple of 360 times an integer. For instance, 108 * 10 = 360 * 3. If we input 108 the figure goes all the way around 3 times before the heading is exactly zero again, and it draws a total of 10 lines.

poly_demo2 1, 108

More Turtle Graphics

A basic class implementation for turtle graphics in autocad –

The basic idea of turtle graphics is that the pen has a location and a direction. The instruction to draw a line only needs distance. The ending point is the new current location. To translate distance at angle from a given point to coordinates the Sin and Cosine are used.

The public class variables are x1, y1 – the current location, the beginning of the line to be drawn, and x2, y2, the calculated end points. Heading is a private double. It is private so that the class can always keep the angle heading between 0 <= heading < 360 no matter how many cumulative turns. A boolean PEN variable allows a PENUP or PENDOWN state.

Turtle1.FD 6 draws a line 6 units (assuming PEN is DOWN). Turtle.Left 45 and Turtle.Right 45 turn heading to the left or right 45 degrees or any number. Input to the user is in degrees. The class module converts to radians in private.

some example code using the turtle class –

Sub turtle_demo_A()
connect_acad

Dim turtle1 As CTurtle
Set turtle1 = New CTurtle

Debug.Print turtle1.x1
Debug.Print turtle1.y1
Debug.Print turtle1.pen
'x1 and y1 are zero
'pen is true
'these are class defaults

Debug.Print turtle1.heading
'access to private variable pheading is thru LET and GET HEADING
'class_initialize default is 90

turtle1.heading = 540
Debug.Print turtle1.heading
'property Let heading (double)
'seems like an argument but you call LET with assignment
'property let heading sets and controls value between 0 <= pheading < 360
'heading is 180

turtle1.heading = turtle1.heading + 180
Debug.Print turtle1.heading
'heading is 0
'just like A = A + 3
'right side of equation is GET and left side is LET

turtle1.heading = turtle1.heading - 45
Debug.Print turtle1.heading
'heading is 315

turtle1.left 90
Debug.Print turtle1.heading
'heading is 45

turtle1.right 90
Debug.Print turtle1.heading
'heading is 315

turtle1.heading = turtle1.heading + 180
Debug.Print turtle1.heading
'heading is 135

turtle1.fd 12
'line is 45 to left

End Sub

all this boils down to –


Sub turtle_demo_B()
connect_acad

Dim turtle1 As CTurtle
Set turtle1 = New CTurtle

turtle1.heading = 45
turtle1.x1 = 2
turtle1.y1 = 3

turtle1.fd 12
End Sub

The Class Module code for the turtle to draw a line contains the trigonometry to calculate the point at dist and angle. It draws the line using the familiar AddLine method with EndPoints as an array of 3 doubles, xyz. This is a 2D implementation, Z is always zero for now but does not have to be.

Public Sub fd(dist As Double)
'assumes x1 y1 and heading
x2 = x1 + dist * Cos(ang2rad(pheading))
y2 = y1 + dist * Sin(ang2rad(pheading))

If pen Then
Call drawline(x1, y1, x2, y2)
End If

'updates to new position
x1 = x2
y1 = y2
End Sub

Sub drawline(x1 As Double, y1 As Double, x2 As Double, y2 As Double)
'internal sub to draw line
Dim acadline As acadline
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
pt1(0) = x1: pt1(1) = y1: pt1(2) = 0
pt2(0) = x2: pt2(1) = y2: pt2(2) = 0

Set acadline = acadDoc.ModelSpace.AddLine(pt1, pt2)
Update
End Sub

Drawing the same line in code with no class implementation –

Sub turtle_demo_C()
connect_acad

Dim acadline As acadline
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double

Dim x1 As Double, y1 As Double
Dim x2 As Double, y2 As Double

Dim ang As Double
Dim dist As Double

x1 = 2
y1 = 3
ang = 45
dist = 12

x2 = x1 + dist * Cos(ang2rad(ang))
y2 = y1 + dist * Sin(ang2rad(ang))

pt1(0) = x1: pt1(1) = y1: pt1(2) = 0
pt2(0) = x2: pt2(1) = y2: pt2(2) = 0

Set acadline = acadDoc.ModelSpace.AddLine(pt1, pt2)
acadApp.Update
End Sub

Instead of doing the calculations, Autocad provides the Utility PolarPoint to do the trig. Polarpoint returns an array. Autodesk help uses a Variant to capture it, but a dynamic array works fine (see pt2).

Sub turtle_demo_D()
connect_acad

Dim acadline As acadline
Dim pt1(0 To 2) As Double
Dim pt2() As Double

Dim x1 As Double, y1 As Double

Dim ang As Double
Dim dist As Double

x1 = 0
y1 = 0
ang = 45
dist = 12

'these are commented out
'x2 = x1 + dist * Cos(ang2rad(ang))
'y2 = y1 + dist * Sin(ang2rad(ang))

pt1(0) = x1: pt1(1) = y1: pt1(2) = 0
pt2 = acadDoc.Utility.PolarPoint(pt1, ang2rad(ang), dist)

Set acadline = acadDoc.ModelSpace.AddLine(pt1, pt2)
acadApp.Update
End Sub

We can further simplify this process with a function to populate point arrays. Every Point can be declared as a dynamic array.

Function Pt(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
Pt = pnt
End Function

Sub turtle_demo_E()
connect_acad

Dim acadline As acadline
Dim pt1() As Double
Dim pt2() As Double

Dim ang As Double
Dim dist As Double

ang = 45
dist = 12

pt1 = Pt(2, 3, 0)
pt2 = acadDoc.Utility.PolarPoint(pt1, ang2rad(ang), dist)

Set acadline = acadDoc.ModelSpace.AddLine(pt1, pt2)
acadApp.Update
End Sub

we can streamline a little bit more with a dedicated Line sub-routine. now lets compare the turtle and more conventional autocad methods. Each will draw a line and turn before drawing the next. Using dynamic arrays, what was pt2 can become pt1 with a simple assignment. That is not possible with the conventional static array where points are declared as – Dim PT1 (0 to 2) as Double.

Sub turtle_demo_F()
connect_acad

Dim turtle1 As CTurtle
Set turtle1 = New CTurtle

turtle1.heading = 30
turtle1.x1 = 1
turtle1.y1 = 2

turtle1.fd 12
turtle1.left 30
turtle1.fd 12

Dim pt1() As Double
Dim pt2() As Double

Dim ang As Double
Dim dist As Double

ang = 45
dist = 12

pt1 = Pt(1, 2, 0)
pt2 = acadDoc.Utility.PolarPoint(pt1, ang2rad(ang), dist)
line1 pt1, pt2

pt1 = pt2
pt2 = acadDoc.Utility.PolarPoint(pt1, ang2rad(ang + 30), dist)
line1 pt1, pt2

acadApp.Update
End Sub

Turtle graphics has geometry implications, start here, go forward, turn and repeat. Turtle graphics is local with a simple interface and limited command set. Coordinate graphics is a global grid, but its interface can also be simplified. The two approaches might be able to work together.

A random star generator –

Sub turtle_demo_6()
init_turtle
Dim dblsize As Double
Dim inc As Integer

For inc = 1 To 480

dblsize = rnddbl(0, 360)
turtle1.heading = dblsize

dblsize = rnddbl(0, 1024)
turtle1.x1 = dblsize

dblsize = rnddbl(512, 1024)
turtle1.y1 = dblsize

dblsize = rnddbl(2, 17)
star_5 dblsize

Next inc

End Sub

Sub star_5(dblsize As Double)

For i = 1 To 5
turtle1.fd dblsize
turtle1.right 144
Next i

End Sub

Function rnddbl(upr As Double, lwr As Double) As Double
' Randomize
' better results without Randomize

rnddbl = CDbl((upr - lwr + 1) * Rnd + lwr)
End Function

any comment in the code causes wordpress to substitute the html equivalent, even the code tag vb with quotations gets corrupted. use wordpress code tag and it moves by itself above an empty line. I really struggle sometimes with wordpress and its code behavior. The only way i even get it to work is to load the old editor. There is an easier way to edit posts, they helpfully remind me. I tried that a few times.