3D Vector Class

Two vectors can be added. Three vectors can be added. Three vectors at right angles on the axes can be resolved as components of any 3D vector.


Sub test_3d_vector3()
Call connect_acad

Dim vs As C3DVector
Dim vt As C3DVector
Dim vu As C3DVector
Dim vv As C3DVector

Set vs = New C3DVector
vs.pts_xyz 0, 0, 0, 3, 0, 0

Set vt = New C3DVector
vt.pts_xyz 0, 0, 0, 0, 4, 0

Set vu = New C3DVector
vu.pts_xyz 0, 0, 0, 0, 0, 5

vs.draw "s"
vt.draw "t"
vu.draw "u"

Set vv = v3D_3_add(vs, vt, vu)
vv.draw "s + t + u"

acadApp.Update
End Sub


Sub test_3d_vector5()
Call connect_acad

Dim i As C3DVector
Dim j As C3DVector
Dim k As C3DVector

Set i = New C3DVector
i.pts_xyz 0, 0, 0, 1, 0, 0

Set j = New C3DVector
j.pts_xyz 0, 0, 0, 0, 1, 0

Set k = New C3DVector
k.pts_xyz 0, 0, 0, 0, 0, 1

i.draw "i"
j.draw "j"
k.draw "k"

Dim rx As C3DVector
Dim ry As C3DVector
Dim rz As C3DVector

Set rx = v3D_scalar(3, i)
Set ry = v3D_scalar(4, j)
Set rz = v3D_scalar(5, k)

Dim resultant As C3DVector
Set resultant = v3D_3_add(rx, ry, rz)

rx.draw "rx"
ry.draw "ry"
rz.draw "rz"
resultant.draw "resultant"

acadApp.Update
End Sub

Advertisements

Vector Class in Autocad VBA

Vectors have length, direction and angle. In engineering and science, vectors can be moved tip to tail to add forces and create a resultant vector. Vectors are equal if magnitude and direction are equal. Position is arbitrary. 2D vectors can fully describe with one (x,y) pair. When the vector starts at (0,0), the end point is also the delta x and delta y.

The autocad line already has everything it needs to be a vector. The direction is saved in separate variables for start and end point. The acadline object in VBA has all the properties required of a vector – StartPoint, EndPoint, Length, Angle and Delta. Delta is the vector. Delta is returned as a 3 place array of doubles, exactly the same as StartPoint and EndPoint, but it’s not a point, it’s (x2-x1, y2-y1, z2-z1). We save it to a variable as if it were a point. We use it to do vector algebra – the algebra of lines.

An object vector is given a variable name, such as U, V, W, S or T, usually lower case and bold, and specified to be equal to the delta values.

angle brackets (this wordpress is html and it will not allow angle brackets for any purpose other than the one it has in its mind) are used to show (x,y) (imagine angle brackets) is not the same thing as (x,y).

Vectors are added by adding their delta values. if u = (ux,uy) and t = (tx,ty) then u + t = (ux+tx, uy+ty). Vectors can also be subtracted and scaled. The angle and length they make can be calculated from the delta. Vectors of different length and angle are easily added to form a new vector with new length and new direction.

A great deal of engineering mechanics and physics vector work can be done just by drawing lines of appropriate length and direction and moving the vectors tip to tail, measuring the resultants.

The parallelogram rule states that if two vectors are to be added, draw them as adjacent sides of a parellogram, the diagonal is the sum. If 3 or more vectors to be added, they are moved one after the other and the resultant is start point to finish.

The math of adding, subtracting and scaling vectors is simple. Creating a vector class in VBA allows the formation, properties and rules of calculations to be formalized. This is a first simple draft.

Vectors in different locations with the same length and direction are declared equal. Math is done on vectors regardless of position. If a vector start point is at 0,0, that is declared to be standard position. In order to physically draw the vector in autocad, we have to have a position. So we may want to specify vectors assuming the start point is 0,0 with length and angle parameters. Or we may want to specify with a single point value as the endpoint. Other vectors we may want to specify the start point and parameters. That gives us 5 possible ways to specify a vector. The first two assume 0,0 as the start point. Using (x1,y1) as start point, and (x2,y2) as endpoint –

vector1 (x2,y2)
vector2 (Length, Theta)
vector3 (x1,y1, x2,y2)
vector4 (x1,y1, Length, Theta)
vector5 (x1,y1,x_delta, y_delta)

In VBA classes, the variables used may be hidden from the user, while the names of property subs are the interface. We use the good names for properties and reference names for the variables. We want (i think) to save all required data even though it is redundant. The angle and length can be calculated from the point values, and vice versa, so they have to be consistent.

property names – variables
3 place array of doubles
pt1 – startpt1
pt2 – endpt2
delta – pdelta

simple doubles
angle – pangle
length – plength
delta_x – pdelta_x
delta_y – pdelta_y
x1 – px1
x2 – px2
y1 – py1
y2 – py2

Properties are implemented with Get (return of value from variable) and Let (assignment of value to variable) statements. The easiest way to start them is to use the VBA editor pulldown under Insert Procedure and click Property. It will add each. We dont really need Let statements yet in this first implementation. Variables are assigned when the vector is first initialized in a single sub procedure. (I am going to post screenshots while this is still in a state of flux.)

The angle of the vector can be calculated from Tangent of delta y over delta x, but tangent has a period of 180 degrees and vectors rotate from 0 to 360, not including 360, so i wrote a simple program to test in each quadrant.

When the vector is specified with length and angle, the initialization sub can be shortened, so it is not redundant. (SLA here stands for Start, Length, Angle)

The vector.draw method –
This arrow is not integral. It is a 1-unit long block inserted at the end point of the line at a scale that looks good using the angle of the vector. The vector line is full length of course, so on-screen calculations work. The arrow can be erased. A switch could be added in a more polished program to arrow or not arrow. The optional parameter adds a text label at the midpoint of the vector.

This is all we need to get started with vectors. The calculation programs are external to the class.

Here is a test demo and the autocad output.

The math is simple, but we will not be able to use VBA symbols “+ – *” for vector addition, subtraction and multiplication. Those are reserved. Subtraction is accomplished by using a -1 scalar factor and adding the negative vector. Functions return a vector object. We need to set up a vector variable to receive the result.

another interesting application of the parallelogram rule is that one diagonal is the sum, the other is the difference.

Autocad Point Variable

All of Autocad graphics methods use a 3 place array of doubles for the coordinates.

The simplest way to sub this is by passing the static array for the sub to fill data.

Dim PtA(0 To 2) As Double
Call pt1(ptA, 1, 2, 0)

Sub pt1(ByRef pnt() As Double, x As Double, y As Double, z As Double)
pnt(0) = x: pnt(1) = y: pnt(2) = z
End Sub

This changes ptA in the calling program. Another way is to make a function and pass the array back to a receiving variable.
This requires a dynamic array.

Dim ptA() As Double
ptA = Pt(1, 2, 0)

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

We can even get away with this – no variables at all.

Set lineAB = acadDoc.ModelSpace.AddLine(Pt(1, 4, 0), Pt(9, 1, 0))

Dynamic arrays can accept point values. A lot of objects return point values, autocad help always seems to use a single variant to hold the array.

The utility polarpoint method returns a point value.

RetVal = object.PolarPoint(Point, Angle, Distance)
Point Type: Variant (three-element array of doubles)
Return Value Type: Variant (three-element array of doubles)

Dim polarPnt As Variant
Dim basePnt(0 To 2) As Double

polarPnt = ThisDrawing.Utility.PolarPoint(basePnt, angle, distance)
Set lineObj = ThisDrawing.ModelSpace.AddLine(basePnt, polarPnt)

PolarPoint returns an array. You cannot assign to a static array. Dynamic arrays can assign. If the declaration is to a dynamic array with the correct type Double it still works (in my version.)

Dim polarPnt() As Double

A Table is an Array

Autocad tables and VBA arrays have the same structure. You can make a sub procedure that takes an array passed as argument that makes an autocad table. The table sub can read the array and determine how many rows and columns it contains. The array is made in any sub specific to the task and separate from making or loading the table. The program flow can make just the data table without Title or Headers and add those later from other data.

The simplest way to make an array is with the array function.

ar_labels = Array(“MKNO”, “QTY”, “LENGTH”, “WIDTH”, “DESC”)
‘ ar_labels is single dimension 0 to cnt – 1

Debug.Print LBound(ar_labels) ‘get 0
Debug.Print UBound(ar_labels) ‘get 4

The autocad method to Addtable requires 5 parameters.

RetVal = object.AddTable(InsertionPoint, NumRows, NumColumns, RowHeight, ColWidth

Rowheight and colwidth is up to you. To keep it simple use what generic table Standard supplies at first. numrows and numcolumns come from looking at the array upper and lower index.

To make a table display a single dimension array in a single row.

Call make_1D_table(ar_labels)

Sub make_1D_table(ar As Variant)
' ar is single dimension 0 to cnt - 1
' tbl is public as AcadTable
' RowHeight and ColWidth are public as double
' location pt0 would be public too as soon as needed

     Dim pt0(0 To 2) As Double '000
     Dim i As Integer, j As Integer
     Dim rowcount As Integer, colcount As Integer
       
    rowcount = 1
    colcount = UBound(ar) - LBound(ar) + 1
  
    'create the table sized for the array
    Set tbl = acadDoc.ModelSpace.AddTable(pt0, rowcount, colcount, RowHeight, ColWidth)
 
      'object.UnmergeCells minRow, maxRow, minCol, maxCol
    tbl.UnmergeCells 0, 0, 0, 0
    tbl.TitleSuppressed = True
     tbl.HeaderSuppressed = True
     
 'right here is where table format has to occur before data is entered

'zero base array fits with autocad zero base table
 For j = 0 To colcount - 1
  If Not IsEmpty(ar(j)) And (ar(j)) <> "" Then
     tbl.SetText 0, j, ar(j)
  End If
 Next j
 
tbl.Update
End Sub


For our main 2 dimensional data table, we do the same thing but get table dims first. One issue that comes up on adding tables is the behavior of title and header rows. Another issue is when text overflows a single line and causes the row width to pop down. It pops down automatically, but not up. The cell width should be set before the data is loaded. This table sub is set up to only make data rows. The way it works though, the table is made with title and header rows, I dont think there is any way to stop that, and then the table object methods are used to modify the table. You might want to make the textsize of the title row the same as data in the table style manager, if you are using the Standard style. Otherwise depending on the data loaded, you may get a top row with a different height.

After we get the table made, in real life we want to have our own tablestyle and probably do some formatting of the text before it is written to screen. I am just showing the data side here.


Public ar_labels As Variant
Public ar_dims As Variant
Public tbl As AcadTable
Public RowHeight As Double
Public ColWidth As Double
Public hexstart As String

Sub make_2D_table(ar As Variant)
'table is two-dimensional and any-base
' ar(rows,columns)
'  tbl is public As AcadTable
'  RowHeight and ColWidth are public as Double
'  pt0 could be public when needed
  
    Dim i As Integer, j As Integer
    Dim rowcount As Integer, colcount As Integer
    Dim rowLbound As Integer, colLbound As Integer
    Dim rowUbound As Integer, colUbound As Integer
     
    Dim pt0(0 To 2) As Double
        
    rowLbound = LBound(ar, 1)
    rowUbound = UBound(ar, 1)
    colLbound = LBound(ar, 2)
    colUbound = UBound(ar, 2)
    rowcount = rowUbound - rowLbound + 1
    colcount = colUbound - colLbound + 1
        
    Set tbl = acadDoc.ModelSpace.AddTable(pt0, rowcount, colcount, RowHeight, ColWidth)
    'the tablestyle does not dictate the use of a title or header
    'at this point the table has a title and header
    'whether they are merged on creation is per style method EnableMergeAll "Title", True
    'if the title row textsize in standard is larger than data textsize
    'the title row cell height may be larger than data rows.
    
   '     data rows only option
     tbl.UnmergeCells 0, 0, 0, 0
     tbl.TitleSuppressed = True
     tbl.HeaderSuppressed = True

 'right here is where table format has to occur before data is entered
 'using the methods of tbl object we could hand off to a sub here
 
       For i = rowLbound To rowUbound
         For j = colLbound To colUbound
             If Not IsEmpty(ar(i, j)) Then
         tbl.SetText i - rowLbound, j - colLbound, ar(i, j)
             End If
         Next j
       Next i
     
 'a sub to add title or header can run next
 'tbl.InsertRows 0, RowHeight, 1
  
    acadApp.Update
End Sub

Here is a sub to make a multiplication table array with 12X12 hard wired in.
You can experiment with different numbers and see if the table sub handles it.
There is no title or header row.


Sub test_mult_tbl()
'only job is to fill array ar_dims global
 Dim rows As Integer, i As Integer
 Dim columns As Integer, j As Integer
 
    rows = 12
    columns = 12
    ReDim ar_dims(1 To rows, 1 To columns)
     
    For i = 1 To rows
       For j = 1 To columns
           ar_dims(i, j) = i * j
       Next j
    Next i
End Sub


Sub test_226()
    Call Connect_Acad
    Call test_mult_tbl
        RowHeight = 0.125
        ColWidth = 0.625
    Call make_2D_table(ar_dims)
End Sub

You can make a font table using ascii codes. Fonts use hex codes which are base 16. A 16X16 table displays 256 characters. After we make the data table we will add a title row and put the name of the font in it.


Sub test_ascii_table()
  ' only job is to make array
  ' 0 to 255 ascii table 16^2
Dim rows As Integer, i As Integer
Dim columns As Integer, j As Integer
     
    rows = 16
    columns = 16
    ReDim ar_dims(1 To rows, 1 To columns)
     
    For i = 1 To rows
        For j = 1 To columns
            'ar_dims(i, j) = CInt(((i - 1) * 16 + (j - 1)))
            ar_dims(i, j) = Chr(((i - 1) * 16 + (j - 1)))
        Next j
    Next i

End Sub

It gets called as before but we are adding a title row after the data is written.
Tablestyles have textstyles, so I am creating a new tablestyle each time using the current font name, and putting that font style name into the tablestyle to be used.


Sub test_228()
Call Connect_Acad

'call style before table call
    Call mk_tbl_styl(acadDoc.GetVariable("textstyle"))

'makes ar_dims
    Call test_ascii_table

    RowHeight = 0.125
    ColWidth = 0.375

    Call make_2D_table(ar_dims)

 'add a title row to top after plain table made
   tbl.InsertRows 0, RowHeight, 1
   tbl.MergeCells 0, 0, 0, tbl.columns - 1
   tbl.TitleSuppressed = False
   tbl.SetText 0, 0, acadDoc.GetVariable("textstyle")
 
End Sub


Unicode is a long extension of ascii. There are many sections. You have to look up the hex code of the section you want to display.


Sub test_unicode()
'only job is to make array of unicode block numbers
'hexstart public string

 Dim numstart As Double
 Dim rows As Integer, i As Integer
 Dim columns As Integer, j As Integer
     
    rows = 16
    columns = 16
    ReDim ar_dims(1 To rows, 1 To columns)
    numstart = HexToDec(hexstart)
 
    For i = 1 To rows
        For j = 1 To columns
            ar_dims(i, j) = DecToHex(numstart + (i - 1) * 16 + (j - 1))
            ar_dims(i, j) = "\U+" & ar_dims(i, j)
        Next j
    Next i
End Sub

Sub test_229()
Call Connect_Acad
Call new_textstyle("Cambria Math", "Cambria Math")

hexstart = "2200"
Call test_unicode
   
   RowHeight = 0.125
   ColWidth = 0.5

Call make_2D_table(ar_dims)
   
   'add title row with caption hexnum and textstyle name
   tbl.InsertRows 0, RowHeight, 1
   tbl.MergeCells 0, 0, 0, tbl.columns - 1
   tbl.TitleSuppressed = False
   tbl.SetText 0, 0, "&H" &  hexstart & " " & acadDoc.GetVariable("textstyle")
 
End Sub


Header rows can be inserted just like Title rows. The header data can come from the Array command. The sub is similar to the 1D sub but even simpler.

Euclid Book 1 Proposition 3

Proposition 3 looks simple, but it uses Proposition 2 which uses Proposition 1. Prop 3 is in turn used by many other Propositions through the entire work.

For debugging it was handy to have a consistent not random pair of given lines, so I made a definite parameter start procedure, selected to look similar to the traditional start points.

Sub prime_pr3()
'given two unequal lines AB and GH
Connect_Acad

Dim ptA(0 To 2) As Double
Dim ptB(0 To 2) As Double
Dim ptG(0 To 2) As Double
Dim ptH(0 To 2) As Double

Dim Ax As Double, Ay As Double
Dim Bx As Double, By As Double
Dim Gx As Double, Gy As Double
Dim Hx As Double, Hy As Double

Ax = rnddbl(0, 5)
Ay = rnddbl(0, 5)
Bx = rnddbl(15, 25)
By = rnddbl(0, 10)
Hx = rnddbl(-5, 0)
Hy = rnddbl(12, 18)
Gx = rnddbl(5, 5)
Gy = rnddbl(12, 18)

Call pt(ptA, Ax, Ay, 0)
Call pt(ptB, Bx, By, 0)
Call pt(ptG, Gx, Gy, 0)
Call pt(ptH, Hx, Hy, 0)

Call pr3_sub(ptA, ptB, ptG, ptH)
    
    acadApp.Update
End Sub


Sub pump_pr3()
'hardwiring two unequal lines AB and GH
Connect_Acad

Dim ptA(0 To 2) As Double
Dim ptB(0 To 2) As Double
Dim ptG(0 To 2) As Double
Dim ptH(0 To 2) As Double

Call pt(ptA, 1, 1, 0)
Call pt(ptB, 10, 2, 0)
Call pt(ptG, 3, 8, 0)
Call pt(ptH, -3, 9, 0)

Call pr3_sub(ptA, ptB, ptG, ptH)
    
    acadApp.Update
End Sub


Sub pr3_sub(ptA() As Double, ptB() As Double, ptG() As Double, ptH() As Double)

Dim lineAB As AcadLine, lineGH As AcadLine
Dim lineAH As AcadLine
Dim lineAE As AcadLine, lineEB As AcadLine
Dim lineAD As AcadLine
Dim circF As AcadCircle

Dim r As Double
Dim intpts As Variant

Dim ptD(0 To 2) As Double
Dim ptE(0 To 2) As Double

Set lineAB = acadDoc.ModelSpace.AddLine(ptA, ptB)
Set lineGH = acadDoc.ModelSpace.AddLine(ptG, ptH)

'i copied sub for prop2 and only added object deletes
'at the bottom otherwise this is same as pr2
'pr2 calls its own pr1
Call pr3_pr2_sub(ptA, ptG, ptH)

 'vertex found
ptD(0) = ptG1(0)
ptD(1) = ptG1(1)
ptD(2) = ptG1(2)

r = distance(ptA, ptD)
Set circF = acadDoc.ModelSpace.AddCircle(ptA, r)

intpts = lineAB.IntersectWith(circF, acExtendNone)
Call intpts_eval(intpts)

'should only be one
ptE(0) = intpts(0)
ptE(1) = intpts(1)
ptE(2) = intpts(2)

lineAB.Delete
'circF.Delete

Set lineAE = acadDoc.ModelSpace.AddLine(ptA, ptE)
Set lineEB = acadDoc.ModelSpace.AddLine(ptE, ptB)

'labels
Dim th As Double
th = 1#

Call txt_h("A", ptA, th)
Call txt_h("B", ptB, th)
Call txt_h("D", ptD, th)
Call txt_h("E", ptE, th)

End Sub

If Euclid had Autocad

The 2300 year old geometry primer begins with definitions for point, line and plane surface establishing these concepts which will be used virtually unchanged even in modern cad applications. A point has no parts, it says. Later geometers will add it only has position but no dimension. A line has only length, no width, only one dimension. A plane surface has both length and width, two dimensions. 17th century mathematicians added XYZ variables to locate position. Euclid constructed, stated (“I say that…”), and proved elementary facts of geometry by starting with the most basic usable definitions and with virtual or real tools of straightedge and compass, that only allowed lines and circles to be constructed, made a textbook of geometry theorems that all depend on previous constructions for the proof of their canonic accuracy. His very first theorem constructs an equilateral triangle, a triangle with all sides and all angles equal, from a single random line.

Euclid has been criticized by moderns because he included no previous definition, postulate or axiom that two circles overlapping intersect in a single point. I thought finding that intersection point would be the hardest part of programming it, but there is a dedicated method, Intersectwith, for nearly every autocad object which returns a single dimension array of x, y and z values for all intersections. Here I just choose the first one. I use a random number generator to create the seed line.


Sub prime_pr1()
'given lineAB call proposition1
Connect_Acad

Dim ptA(0 To 2) As Double
Dim ptB(0 To 2) As Double
Dim Ax As Double, Ay As Double
Dim Bx As Double, By As Double

Ax = rnddbl(0, 10)
Ay = rnddbl(0, 10)
Bx = rnddbl(11, 20)
By = rnddbl(0, 10)

Call pt(ptA, Ax, Ay, 0)
Call pt(ptB, Bx, By, 0)
   
   Call pr1(ptA, ptB)
acadApp.Update
End Sub


Sub pr1(ptA() As Double, ptB() As Double)
Dim lineAB As AcadLine, lineAC As AcadLine, lineBC As AcadLine
Dim circD As AcadCircle, circE As AcadCircle
Dim ptC(0 To 2) As Double

Dim r As Double
Dim intpts As Variant

Set lineAB = acadDoc.ModelSpace.AddLine(ptA, ptB)

r = distance(ptA, ptB)
Set circD = acadDoc.ModelSpace.AddCircle(ptA, r)

r = distance(ptB, ptA)
Set circE = acadDoc.ModelSpace.AddCircle(ptB, r)

intpts = circD.IntersectWith(circE, acExtendNone)
Call intpts_eval(intpts)

'going to take positive y value
'keeps traditional illustrations upright
    If ptG1(1) > ptG2(1) Then
ptC(0) = ptG1(0)
ptC(1) = ptG1(1)
ptC(2) = ptG1(2)
    Else
ptC(0) = ptG2(0)
ptC(1) = ptG2(1)
ptC(2) = ptG2(2)
    End If

Set lineAC = acadDoc.ModelSpace.AddLine(ptA, ptC)
Set lineBC = acadDoc.ModelSpace.AddLine(ptB, ptC)

End Sub



helper functions


Option Explicit

Public num_int_pts As Integer

Public ptG1(0 To 2) As Double
Public ptG2(0 To 2) As Double

'to evaluate the output array of the Intersectwith method
'loads up to two points in a global variable
'the calling program has to decide which one to use
'the core loop here taken directly out of autocad vba help for Intersectwith method
Sub intpts_eval(intpts As Variant)
 Dim i As Integer, j As Integer, k As Integer
    Dim str As String

If VarType(intpts) <> vbEmpty Then
        For i = LBound(intpts) To UBound(intpts)
            str = "Intersection Point[" & k & "] is: " & intpts(j) & "," & intpts(j + 1) & "," & intpts(j + 2)
            Debug.Print str
            str = ""
            i = i + 2
            j = j + 3
            k = k + 1
        Next
    End If
    
    Debug.Print LBound(intpts)
    Debug.Print UBound(intpts)
    
  'global var
  num_int_pts = k
  
  Select Case k
  Case Is = 0
  ptG1(0) = 0: ptG1(1) = 0: ptG1(2) = 0
  ptG2(0) = 0: ptG2(1) = 0: ptG2(2) = 0
  
  Case Is = 1
  Call pt(ptG1, (intpts(0)), (intpts(1)), (intpts(2)))
  ptG2(0) = 0: ptG2(1) = 0: ptG2(2) = 0
    
  Case Is = 2
  Call pt(ptG1, (intpts(0)), (intpts(1)), (intpts(2)))
  Call pt(ptG2, (intpts(3)), (intpts(4)), (intpts(5)))
 
  Case Is > 2
    MsgBox "thats a lot of points"
 End Select
End Sub


Sub pt(ByRef ptn() As Double, x As Double, y As Double, z As Double)
ptn(0) = x: ptn(1) = y: ptn(2) = z
End Sub

Function rnddbl(upr As Double, lwr As Double) As Double
Randomize
rnddbl = CDbl((upr - lwr + 1) * Rnd + lwr)
End Function

' straight out of autocad vba help
' Calculate distance between two points
Function distance(sp As Variant, ep As Variant) As Double
  Dim x As Double
  Dim y As Double
  Dim z As Double
  x = sp(0) - ep(0)
  y = sp(1) - ep(1)
  z = sp(2) - ep(2)

  distance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))
End Function