Sub flat1(L As Double, C As Double) 'L = N x C + 2R 'L and C are the inputs 'Length and Centers 'N and R are the outputs 'N = Number of full spaces 'R = length of ends - Remainder Dim N As Integer Dim R As Double Dim str As String Dim i As Integer If L / C < 1.25 Then MsgBox " L / C < 1.25 " Exit Sub End If N = Fix(L / C) R = (L - N * C) / 2 If R < 0.25 * C Then N = N - 1 R = (L - N * C) / 2 End If 'now N and R are derived If hole_slot = "SLOT" Then Call flat_slot(L, N, C, R) End If If hole_slot = "HOLE" Then Call flat_hole(L, N, C, R) End If acadApp.Update End Sub

# Parametric Dimensioning

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

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

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

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

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

Dim pts As Variant

x0 = 0

x1 = W

x2 = W + B – 0.375

x3 = W + B

x4 = x2

x5 = 0.125

x6 = 0.125 + W

y0 = 0

y1 = W

y2 = W + A – 0.375

y3 = W + A

y4 = y2

y5 = 0.125

y6 = 0.125 + W

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

Call draw_array(pts)

bound_box pts

dimloc LL, UR, sc

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

Public LL() As Double

Public UR() As Double

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

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

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

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

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

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

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

Sub OS_CRNR(A As Double, B As Double, W As Double) Call OS_CRNR_draw(A, B, W) do_os_crnr_note flat_dim = A + B Do_bend_det Do_border Do_title Etc Etc End Sub Sub OS_CRNR_draw(A As Double, B As Double, W As Double) Dim x0 As Double, y0 As Double Dim x1 As Double, x2 As Double, x3 As Double, x4 As Double, x5 As Double, x6 As Double Dim y1 As Double, y2 As Double, y3 As Double, y4 As Double, y5 As Double, y6 As Double Dim pts As Variant x0 = 0 x1 = W x2 = W + B - 0.375 x3 = W + B x4 = x2 x5 = 0.125 x6 = 0.125 + W y0 = 0 y1 = W y2 = W + A - 0.375 y3 = W + A y4 = y2 y5 = 0.125 y6 = 0.125 + W pts = Array(x0, y0, x2, y0, x3, y5, x3, y6, x4, y1, x1, y1, x1, y4, x6, y3, x5, y3, x0, y2) Call draw_array(pts) global_pline.Layer = "0" bound_box pts dimloc LL, UR, sc pt1 = pt(x1, y1, 0) pt2 = pt(x5, y3, 0) pt3 = pt(x3, y5, 0) pt4 = pt(x0, y3 - 0.625, 0) pt5 = pt(x3 - 0.625, y0, 0) dimv pt1, pt2, vt1 dimh pt1, pt3, hz1 dimv pt4, pt2, vt2 dimh pt5, pt3, hz2 do_screw pt4, 0 do_screw pt5, PI / 2 acadApp.Update End Sub Sub dimv(pt1() As Double, pt2() As Double, dimlocpt() As Double) Dim dimObj As AcadDimRotated Set dimObj = acadDoc.ModelSpace.AddDimRotated(pt1, pt2, dimlocpt, PI / 2) dimObj.Layer = "DIM" End Sub Sub dimh(pt1() As Double, pt2() As Double, dimlocpt() As Double) Dim dimObj As AcadDimRotated Set dimObj = acadDoc.ModelSpace.AddDimRotated(pt1, pt2, dimlocpt, 0) dimObj.Layer = "DIM" End Sub

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

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

‘vert dim line locations left to right

Public vt1() As Double

Public vt2() As Double

Public vt3() As Double

Public vt4() As Double

‘horiz dim line locations bottom to top

Public hz1() As Double

Public hz2() As Double

Public hz3() As Double

Public hz4() As Double

Public LL() As Double

Public UR() As Double

Public LL2() As Double

Public UR2() As Double

# Point Data

Point Data

Here is the cumbersome addline method (ActiveX aka VBA) autocad knowledge network. I have simplified the point names.

Dim lineObj As AcadLine

Dim pt1(0 To 2) As Double

Dim pt2(0 To 2) As Double

pt1(0) = 1#: pt1(1) = 1#: pt1(2) = 0#

pt2(0) = 5#: pt2(1) = 5#: pt2(2) = 0#

Set lineObj = ThisDrawing.ModelSpace.AddLine(pt1, pt2)

When I first started autocad VBA I emailed an autodesk blog writer and suggested to him this wordiness practically eliminated any possibility of useful or popular parametrics and why not develop some simplified techniques in a column. He replied, first of all I have not used VBA in years, and secondly, I don’t have time to give you support. Alright fine. Stay away from my daughter. They seem to have solved the problem in dot net, but added another realm of issues. Here is the relevant line to create a Line object in (.NET), only one line of many.

Using acLine As Line = New Line(New Point3d(5, 5, 0), New Point3d(12, 3, 0))

You can do that in VBA. The std VBA help above is rewritten as –

Dim lineobj As AcadLine

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

pt1 = pt(1, 1, 0)

pt2 = pt(5, 5, 0)

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

To do the shorthand method as in the (.NET) example with the inline assignment –

Dim lineobj As AcadLine

Set lineobj = acadDoc.ModelSpace.AddLine(pt(1, 1, 0), pt(5, 5, 0))

The (.NET) example also has 12 other lines to connect to the autocad unit. My program would also have about that number of lines, except I sub out once per session using a global object variable so the object keyword ThisDrawing becomes AcadDoc, and its invoked as

Connect_acad

Whats happening here is that the old method of declaring points is using a static array, and the new method is using a dynamic array. A static array cannot be assigned to a variable.

pt1 = pt2

Will give an error if pt1 was declared a static array, and it will be fine if it was a dynamic array. Pt2 can be either in this example.

The function to set point data then is always used, just as the (.NET) coders did with Point3D. There is no downside. The variable is always declared as a dynamic array.

Dim pt1() as double

pt1 = pt(1,2,3)

The function takes the xyz values and returns a dynamic point array used everywhere a static point would be used. In fact it declares a static array, but then passes that to a dynamic array. This little function opens up a world of productivity.

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

Wrapper functions to draw lines, circles, text, dimensions, etc can always pass point arrays rather than xyz values for simplicity. Its easier to develop the points in the calling function even if they need to be deconstructed in the called function.

A simple orthogonal 2D box, a very common item, is defined by two points on opposite corners. It requires two x values and two y values. The function is designed with an illustration that shows the box being drawn a particular direction, but in practice any two random points define one and only one orthogonal rectangle, providing they have neither x or y in common. The lightweight polyline is used in this case. Points are passed but then the xy values are extracted and formatted for the polyline array.

Sub mbox(p1() As Double, p2() As Double) Dim objent As AcadLWPolyline Dim pts(0 To 7) As Double Dim x0 As Double, x1 As Double Dim y0 As Double, y1 As Double x0 = p1(0) x1 = p2(0) y0 = p1(1) y1 = p2(1) pts(0) = x0: pts(1) = y0 pts(2) = x1: pts(3) = y0 pts(4) = x1: pts(5) = y1 pts(6) = x0: pts(7) = y1 Set objent = acadDoc.ModelSpace.AddLightWeightPolyline(pts) objent.Closed = True objent.Layer = "0" End Sub

This illustrates how the 2D polyline works with an array of alternating x and y values. It doesnt use the point function, but the calling sub does with little problem.

Dim pt1() as double, pt2() as double

pt1 = pt(6, 1, 0)

pt2 = pt(2, 5, 0)

mbox pt1, pt2

The same thing could be drawn with lines with pts passed and used directly. I like objects that stay connected. The closed polyline takes an array twice the size of the number of vertexes consisting only of x and y values. The x and y values are the data used to draw. The parameters are the concept variables that push the x and y values around. For instance a sheet metal channel, would have 3 variables – the width, the leg, and the thickness of the material. Lets draw one where each leg can vary – 4 variables.

First step is to draw the object in the same rotation the program will use and label all x and y values. The easiest place to draw the object is with x0 and y0 at 0,0, so I assume that but you could draw it in place with a little more rigor. These type of sketches are not complete until dimensions, text, screws, notes, holes, other block details are added, and the whole assembly moved into a print border. I draw those using the xy data, and move the entire assembly into 8×10 print format all at once. If I have a list, I move that bunch over (in program) and start a new piece.

Looking at this sketch, we know we need a J_CHAN sub passing A, B, C and W for parameters.

The first thing the sub does is declare the x and y variables needed, and a dynamic array to put them into. x values then y values are specified in terms of A, B, C and W.

Sub J_CHAN2(A As Double, B As Double, C As Double, W As Double)

‘A is WIDTH, B is FRONT VERT, C is BACK VERT

Dim x0 As Double, y0 As Double

Dim x1 As Double, x2 As Double, x3 As Double

Dim y1 As Double, y2 As Double, y3 As Double

Dim pts As Variant

x0 = 0

y0 = 0

x1 = W

x2 = W + A

x3 = 2 * W + A

y1 = W

y2 = W + B

y3 = W + C

Now we have all the data to draw the object. The problem now is getting it to the 2D Polyline.

Addlightweightpolyline method takes an array of doubles. We used it with the Box sub. It has the same syntax as the old point method. Its a static array. It has the same cumbersome requirements. Every shape that has a different number of vertices requires the proper size array.

Here is the autocad help example. I added connect_acad and changed ThisDrawing to acadDoc to get it to run (from excel). This draws a 4-line squiggle, using 5 points (for some reason 2 segments are in line). So you need 10 places in the array, 0 to 9.

Sub Example_AddLightWeightPolyline() ' This example creates a lightweight polyline in model space. Call Connect_Acad Dim plineObj As AcadLWPolyline Dim points(0 To 9) As Double ' Define the 2D polyline points points(0) = 1: points(1) = 1 points(2) = 1: points(3) = 2 points(4) = 2: points(5) = 2 points(6) = 3: points(7) = 2 points(8) = 4: points(9) = 4 ' Create a lightweight Polyline object in model space Set plineObj = acadDoc.ModelSpace.AddLightWeightPolyline(points) ZoomAll End Sub

The easiest way to make an array in VBA is with the Array function. The array function returns a variant containing an array. The syntax is very simple. You do not have to index the locations.

Dim Ar as variant

Ar = Array(1,1,1,2,2,2,3,2,4,4)

The data is the same as above but the array is not the same. Polyline won’t accept it. “Invalid argument.” It’s a variant that contains an array. VBA won’t assign the variant to a dynamic array either. We have to step through it to convert it to an array of doubles that polyline will use. But that gives us a chance to write a sub that will accept an array of any length. So we can make our point list with the simple array function, then hand it off to a sub to draw.

Sub test_array() Call Connect_Acad Dim Ar As Variant Ar = Array(1, 1, 1, 2, 2, 2, 3, 2, 4, 4) draw_ar Ar End Sub Sub draw_ar(pt As Variant) Dim pt2() As Double Dim objent As AcadLWPolyline Dim i As Integer Dim lower As Integer, upper As Integer lower = LBound(pt) upper = UBound(pt) ReDim pt2(lower To upper) For i = lower To upper pt2(i) = pt(i) Next i Set objent = acadDoc.ModelSpace.AddLightWeightPolyline(pt2) ' objent.Closed = True objent.Update End Sub

I have the polyline not closed to duplicate the autocad help example. Now my draw sub will draw any list given to it of any length and I can randomly add pairs of numbers to the list to test it.

Lets go back to our J-Channel and make the array of x and y values with the Array function then pass it off to be drawn. Final working version here.

Sub test_chan() Call Connect_Acad Call J_CHAN2(4, 2, 3, 0.0625) End Sub Sub J_CHAN2(A As Double, B As Double, C As Double, W As Double) 'A is WIDTH, B is FRONT VERT, C is BACK VERT Dim x0 As Double, y0 As Double Dim x1 As Double, x2 As Double, x3 As Double Dim y1 As Double, y2 As Double, y3 As Double Dim pts As Variant x0 = 0 y0 = 0 x1 = W x2 = W + A x3 = 2 * W + A y1 = W y2 = W + B y3 = W + C pts = Array(x0, y0, x3, y0, x3, y3, x2, y3, x2, y1, x1, y1, x1, y2, x0, y2, x0, y0) Call draw_array(pts) global_pline.Layer = "0" acadApp.Update End Sub Sub draw_array(pt As Variant) Dim pt2() As Double Dim objent As AcadLWPolyline Dim i As Integer Dim lower As Integer, upper As Integer lower = LBound(pt) upper = UBound(pt) ReDim pt2(lower To upper) For i = lower To upper pt2(i) = pt(i) Next i Set objent = acadDoc.ModelSpace.AddLightWeightPolyline(pt2) objent.Closed = True objent.Update Set global_pline = objent End Sub

—

Point data starts with x and y values. X and Y and Z values are loaded into point arrays.

# Direction Cosines

Inclination – angle in radians or degrees a 2D line makes with the positive x-axis, measuring counter-clockwise. A line extends indefinitely in both directions.

In radians, 0 <= theta < pi

In degrees, 0 <= theta < 180

Slope – tangent of the inclination, y/x, rise over run.

Slope m = Tan alpha = y/x

Lines are perpendicular if their slopes are m1 = -1/m2

Tan alpha = – tan (180 – alpha)

A 3D line, a 3D vector, is determined by any two points. If one of these points is the origin, the coordinates of every point on the line form a set of direction numbers. Every line has an infinite set of direction numbers. The numbers always have the same proportions. You can get the coordinates of any point by multiplying the coordinates of some other point by some constant.

The direction angles of a 3D line are defined to be the angle the line makes directly with each of the positive axes. Knowing any two the third can be calculated. The angles are limited to 0 to 180, similar to the 2D inclination, but not limited to being counter-clockwise.

For an undirected line that extends indefinitely in both directions, there are two sets of direction angles,

theta and (180 – theta)

The basic calculation of 3D line direction is the division of the direction numbers by the length between the two points that generated that set. This gives the direction cosines, the x,y and z values for a line of length one. Multiplying the direction cosines by a constant gives a point on the same line at distance of the constant. The 3 direction angles of the line can be found with the Cos(-1) function.

For instance a line from the origin to (3,4,5) has a length of 7.07. The direction cosines are 3/7.07, 4/7.07, 5/7.07), the angle of the line to each of the axes, xyz, by calculator cos(-1), is approx 65, 55, and 45 degrees. Lets check that out with autocad and VBA.

Sub test24() Call Connect_Acad Dim x As Double, y As Double, z As Double Dim pt0() As Double pt0 = pt(0, 0, 0) Dim ptX() As Double 'pt on x axis to make alpha ucs Dim ptY() As Double 'pt on y axis to make beta ucs Dim ptZ() As Double 'pt on z axis to make gamma ucs 'i could re-use these to only have one Dim ptx2() As Double 'pt to define new x axis for alpha Dim pty2() As Double 'pt to define new x axis for beta Dim ptz2() As Double 'pt to define new x axis for gamma Dim A() As Double, B() As Double, C() As Double Dim dir_cos() As Double Dim dir_ang() As Double x = -3: y = -4: z = 5 A = pt(x, y, z) 'draw the autocad line vec_draw1 A ptX = pt(x, 0, 0) ptx2 = pt(x + 1, 0, 0) ucs ptX, ptx2, A, "ucs_alpha" ptX = pt(Abs(x), 0, 0) dim_ang pt0, ptX, A, midpt2(ptX, A) label_pt A, "A" ptY = pt(0, y, 0) pty2 = pt(0, y + 1, 0) ucs ptY, pty2, A, "ucs_beta" ptY = pt(0, Abs(y), 0) dim_ang pt0, ptY, A, midpt2(ptY, A) ptZ = pt(0, 0, z) ptz2 = pt(0, 0, z + 1) ucs ptZ, ptz2, A, "ucs_gamma" ptZ = pt(0, 0, Abs(z)) dim_ang pt0, ptZ, A, midpt2(ptZ, A) 'the box is a visual aid not always required 'Dim pt1() As Double 'pt1 = pt(x / 2, y / 2, z / 2) 'solidbox pt1, Abs(x), Abs(y), Abs(z) 'here are the calculations dir_cos = dir_cos1(A) Debug.Print "< " & x; ", " & y & ", " & z & " >" Debug.Print "alpha_cos " & dir_cos(0) Debug.Print "beta_cos " & dir_cos(1) Debug.Print "gamma_cos " & dir_cos(2) Debug.Print 'direction cosines are the xyz values where the line 'has a length of one 'put an autocad point object at those coordinates draw_pt dir_cos, "L=1" dir_ang = dir_ang1(A) Debug.Print "Alpha " & rad2deg(dir_ang(0)) Debug.Print "Beta " & rad2deg(dir_ang(1)) Debug.Print "Gamma " & rad2deg(dir_ang(2)) Debug.Print 're-set ucs to world set_wcs acadApp.Update End Sub

Call the autocad dimangular method. First the ucs is changed for each of the 3 angles. UCS requires 3 points. a new origin, a point on the new x-axis, and a point on the new y-axis. the origin is variously either (x,0,0), (0,y,0), or (0,0,z), the point on the new x-axis is variously (x+1,0,0), (0,y+1,0) or (0,0,z+1). the point on the new y-axis is always the point of the vector. that establishes a right triangle in the plane of the vector and the axis to which the angular dimension is drawn.

Sub dim_ang(pt1() As Double, pt2() As Double, pt3() As Double, pt4() As Double) Dim dimObj As AcadDimAngular 'Set dimObj = acadDoc.ModelSpace.AddDimAngular(AngleVertex, firstendpoint, secondendpoint, textpoint) Set dimObj = acadDoc.ModelSpace.AddDimAngular(pt1, pt2, pt3, pt4) End Sub

Independently of the autocad dimangular method, the direction cosines and direction angles are calculated. Since these are always triples, the most convenient way to store them is in a 3 place array of doubles, exactly as point coordinates are stored. In fact the direction cosines are the point coordinates for any line at the point where the length of the line is one. Both direction cosines and direction angles are calculated for a vector with tail at the origin. The version to calculate with tail not at the origin would simply do the subtraction of coordinates then call this version.

Function dir_cos1(pt1() As Double) As Double() Dim cos_alpha As Double, cos_beta As Double, cos_gamma As Double Dim x As Double, y As Double, z As Double Dim D As Double D = dist1(pt1) If D = 0 Then dir_cos1 = pt(0, 0, 0) Exit Function End If x = pt1(0): y = pt1(1): z = pt1(2) cos_alpha = x / D cos_beta = y / D cos_gamma = z / D dir_cos1 = pt(cos_alpha, cos_beta, cos_gamma) End Function Function dir_ang1(pt1() As Double) As Double() Dim alpha As Double, beta As Double, gamma As Double Dim dir_cos() As Double Dim pt2(0 To 2) As Double dir_cos = dir_cos1(pt1) alpha = WorksheetFunction.Acos(dir_cos(0)) beta = WorksheetFunction.Acos(dir_cos(1)) gamma = WorksheetFunction.Acos(dir_cos(2)) pt2(0) = alpha pt2(1) = beta pt2(2) = gamma dir_ang1 = pt2 End Function

testing the subroutine for values in all 8 quadrants. the angles are always measured to the positive side of the axis. therefore they are always between 0 and 180, never negative. Getting the confidence that all quadrants return true values, the next step is to develop a sub-routine that returns the angle between two lines.

# 3D Line – part 2

The distance formula

Function dist1(pt1() As Double) As Double Dim x As Double, y As Double, z As Double x = pt1(0): y = pt1(1): z = pt1(2) dist1 = (x ^ 2 + y ^ 2 + z ^ 2) ^ (1 / 2) End Function Function dist2(pt1() As Double, pt2() As Double) As Double Dim x As Double, y As Double, z As Double x = pt2(0) - pt1(0) y = pt2(1) - pt1(1) z = pt2(2) - pt1(2) dist2 = (x ^ 2 + y ^ 2 + z ^ 2) ^ (1 / 2) End Function

test sub

Sub test17() Call Connect_Acad Dim A() As Double, B() As Double Dim x As Double, y As Double, z As Double x = 5 y = 4 z = 3 A = pt(x, y, z) B = pt(x, y, 0) line1 A txt1 midpt1(A), dec2(dist1(A)) line1 B txt1 midpt1(B), dec2(dist1(B)) line1 pt(x, 0, 0) txt1 midpt1(pt(x, 0, 0)), dec2(x) line1 pt(0, y, 0) line1 pt(0, 0, z) line2 A, B txt1 midpt2(A, B), dec2(dist2(A, B)) line2 pt(x, 0, 0), B txt1 midpt2(pt(x, 0, 0), B), dec2(y) label_pt2 A, "A", 2 label_pt2 B, "B", 2 Dim pt1() As Double pt1 = pt(x / 2, y / 2, z / 2) solidbox pt1, x, y, z End Sub

text and label subs

Sub txt1(pt1() As Double, str As String, Optional height As Variant, Optional rotation As Variant) Dim objtxt As AcadText If IsMissing(height) Then height = textheight 'global var End If If IsMissing(rotation) Then rotation = 0 End If Set objtxt = acadDoc.ModelSpace.AddText(str, pt1, height) objtxt.Layer = "0" If rotation <> 0 Then objtxt.rotation = deg2rad(CDbl(rotation)) End If End Sub Sub label_pt2(pt1() As Double, Optional str_label As String = "none", Optional prec As Integer = 4) If IsMissing(height) Then height = textheight 'global var End If Dim str As String Dim x As Double, y As Double, z As Double x = Round(pt1(0), prec) y = Round(pt1(1), prec) z = Round(pt1(2), prec) str = "<" & x & "," & y & "," & z & ">" If str_label <> "none" Then str = str_label & " " & str End If txt1 pt1, str, textheight End Sub Function dec2(number As Double) As Double Dim dbl As Double dbl = Round(number, 2) dec2 = dbl End Function

Acad3DSolid box sub. Transparency is a percentage 1 to 90. Higher numbers are more transparent.

Sub solidbox(pt() As Double, leng As Double, wid As Double, height As Double) Dim objbox As Acad3DSolid Set objbox = acadDoc.ModelSpace.AddBox(pt, leng, wid, height) objbox.EntityTransparency = 80 acadApp.Update End Sub

midpoint

Function midpt1(pt1() As Double) As Double() Dim x As Double, y As Double, z As Double x = pt1(0): y = pt1(1): z = pt1(2) midpt1 = pt(x / 2, y / 2, z / 2) End Function Function midpt2(pt1() As Double, pt2() As Double) As Double() Dim x1 As Double, y1 As Double, z1 As Double x = (pt1(0) + pt2(0)) / 2 y = (pt1(1) + pt2(1)) / 2 z = (pt1(2) + pt2(2)) / 2 midpt2 = pt(x, y, z) End Function

test sub

Sub test18() Call Connect_Acad Dim A() As Double, B() As Double, C() As Double A = pt(2, 1, 3) B = pt(3, -1, -2) C = pt(0, 2, -1) line2 A, B line2 B, C line2 C, A line2 midpt2(A, B), midpt2(B, C) line2 midpt2(B, C), midpt2(C, A) line2 midpt2(C, A), midpt2(A, B) label_pt2 A, "A" label_pt2 B, "B" label_pt2 C, "C" label_pt2 midpt2(A, B) label_pt2 midpt2(B, C) label_pt2 midpt2(C, A) acadApp.Update End Sub

the angles to 3 decimal places

the triangles are all congruent. the middle triangle has half the perimeter of the outer triangle and one fourth the area.

# Vectors in the Plane

Dim A() As Double, B() As Double Dim C() As Double, D() As Double Dim R() As Double A = pt(4, 1, 0) B = pt(2, -3, 0) C = pt(-2, 2, 0) D = pt(-3, -2, 0) vec_draw1 A, "A" vec_draw1 B, "B" vec_draw1 C, "C" vec_draw1 D, "D" R = v_add(A, B) vec_draw1 R, "A+B" R = v_add(A, C) vec_draw1 R, "A+C" R = v_add(A, D) vec_draw1 R, "A+D" R = v_add3(A, B, C) vec_draw1 R, "A+B+C" R = vec_add_2(1, A, 2, B) vec_draw1 R, "A+2B" R = vec_add_2(1, A, -3, C) vec_draw1 R, "A-3C" R = v_add3(A, C, v_m(1 / 3, D)) vec_draw1 R, "A+C+1/3D" Sub vec_draw1(pt1() As Double, Optional str_text As Variant) 'line from origin to pt1 Dim lineobj As AcadLine Set lineobj = acadDoc.ModelSpace.AddLine(pt(0, 0, 0), pt1) If Not IsMissing(str_text) Then txt1 CStr(str_text), pt1, 0.25 End If End Sub 'add 2 vectors, return vector Function v_add(pt1() As Double, pt2() As Double) As Double() v_add = pt(pt1(0) + pt2(0), pt1(1) + pt2(1), pt1(2) + pt2(2)) End Function 'multiply scalar by vector, return vector Function v_m(m As Double, pt1() As Double) As Double() v_m = pt(m * pt1(0), m * pt1(1), m * pt1(2)) End Function 'add 3 vectors, return vector Function v_add3(pt1() As Double, pt2() As Double, pt3() As Double) As Double() v_add3 = pt(pt1(0) + pt2(0) + pt3(0), pt1(1) + pt2(1) + pt3(1), pt1(2) + pt2(2) + pt3(2)) End Function 'add 2 vectors each multiplied by a scalar, A-B would be vec_add_2(1, A, -1, B) Function vec_add_2(m As Double, pt1() As Double, n As Double, pt2() As Double) As Double() Dim temp1() As Double, temp2() As Double temp1 = v_m(m, pt1) temp2 = v_m(n, pt2) vec_add_2 = v_add(temp1, temp2) End Function

it would be possible to do this on one line but it would be hard to read.

Dim temp1() As Double, temp2() As Double temp1 = vec_add_2(2, A, -3, B) temp2 = vec_add_2(-3, C, 4, D) R = v_add(temp1, temp2) vec_draw1 R, "2A-3B-3C+4D"

Length and Direction –

Function vec_len(pt1() As Double) As Double Dim x As Double, y As Double, z As Double x = pt1(0): y = pt1(1): z = pt1(2) vec_len = (x ^ 2 + y ^ 2 + z ^ 2) ^ (1 / 2) End Function

Dividing a vector by the length (multiplying by the inverse of the length) produces a vector with length one in the same direction –

The angle of a 2D vector is a directed line measured from the positive X axis. It takes a value between 0 and 360 degrees not including 360 or 0 and 2 pi not including 2 pi. The inverse tangent is used with y/x as argument. Tangent returns an angle for an undirected line between -90 to +90 or -pi/2 to +pi/2. The code is a bit tedious but its pretty straightforward. We have to trap out zero values of x, to avoid divide by zero, then check for zeros of y and interpret, then retrieve the value for the inverse tangent and interpret according to which quadrant the head of the vector is in.

Function vec_ang(pt1() As Double) As Double 'returns angle in radians 'check for zero length vector return 0 for angle Dim x As Double, y As Double x = pt1(0) y = pt1(1) If x = 0 And y = 0 Then vec_ang = 0 Exit Function End If 'get axis directions If x = 0 Or y = 0 Then If y = 0 And x > 0 Then vec_ang = 0 If x = 0 And y > 0 Then vec_ang = Pi / 2 If y = 0 And x < 0 Then vec_ang = Pi If x = 0 And y < 0 Then vec_ang = 3 * Pi / 2 Exit Function End If 'calculate m tangent Dim m As Double m = y / x If x > 0 And y > 0 Then 'First Q 'Debug.Print rad2deg(Atn(m)) vec_ang = Atn(m) End If If x < 0 And y > 0 Then 'Second Q 'Debug.Print rad2deg(Atn(m)) vec_ang = Pi + Atn(m) End If If x < 0 And y < 0 Then 'Third Q 'Debug.Print rad2deg(Atn(m)) vec_ang = Pi + Atn(m) End If If x > 0 And y < 0 Then 'Fourth Q 'Debug.Print rad2deg(Atn(m)) vec_ang = 2 * Pi + Atn(m) End If End Function

Sub vec_draw3(startpt1() As Double, vectorpt2() As Double, Optional str_text As Variant) 'line from startpoint at vector distance and angle Dim lineobj As AcadLine Dim pt3() As Double pt3 = v_add(startpt1, vectorpt2) Set lineobj = acadDoc.ModelSpace.AddLine(startpt1, pt3) If Not IsMissing(str_text) Then txt1 CStr(str_text), pt1, 0.25 End If End Sub

triangles with random vertexes and medians – (I moved them after the program drew them)

Sub vec_draw2(pt1() As Double, pt2() As Double, Optional str_text As Variant) 'simple line from pt1 to pt2 Dim lineobj As AcadLine Set lineobj = acadDoc.ModelSpace.AddLine(pt1, pt2) If Not IsMissing(str_text) Then txt1 CStr(str_text), midpt2(pt1, pt2), 0.25 End If End Sub

# 3D Line – part 1

A straight line is completely determined by the coordinates of its endpoints. A straight line having a definite length and direction but no definite location in space is a vector. In its most basic form its a single point. A vector and a point are both a 3-array of doubles. Make them a dynamic array.

The functions to calculate direction, midpt, cosines, addition and scalar multiplication of vectors all return an array of 3 doubles. The line subroutines work with arrays of 3 doubles. Where I have one point argument, assuming 0,0,0 for the other, I number the routine_1. Where I have two point arguments, I number the routine_2. Passing and assigning points cleans up the code to almost logo like clarity.

dim pt1() as double, pt2() as double

pt1 = pt(2, 4, 6)

pt2 = pt(1, 9, 10)

line1 pt1

line1 pt2

line2 pt1, pt2

line2 midpt1(pt1), midpt1(pt2)

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 line1(pt1() As Double) 'line from origin to pt1 Dim lineobj As AcadLine Set lineobj = acadDoc.ModelSpace.AddLine(pt(0, 0, 0), pt1) End Sub Sub line2(pt1() As Double, pt2() As Double) 'line from pt1 to pt2 Dim lineobj As AcadLine Set lineobj = acadDoc.ModelSpace.AddLine(pt1, pt2) End Sub Sub line3(startpt1() As Double, vectorpt2() As Double) 'line from startpoint at vector distance and angle Dim lineobj As AcadLine Dim pt3() As Double pt3 = add_vectors(startpt1, vectorpt2) Set lineobj = acadDoc.ModelSpace.AddLine(startpt1, pt3) End Sub

Function dist1(pt1() As Double) As Double Dim x As Double, y As Double, z As Double x = pt1(0): y = pt1(1): z = pt1(2) dist1 = (x ^ 2 + y ^ 2 + z ^ 2) ^ (1 / 2) End Function Function dist2(pt1() As Double, pt2() As Double) As Double Dim x As Double, y As Double, z As Double x = pt2(0) - pt1(0) y = pt2(1) - pt1(1) z = pt2(2) - pt1(2) dist2 = (x ^ 2 + y ^ 2 + z ^ 2) ^ (1 / 2) End Function Function midpt1(pt1() As Double) As Double() Dim x As Double, y As Double, z As Double x = pt1(0): y = pt1(1): z = pt1(2) midpt1 = pt(x / 2, y / 2, z / 2) End Function Function midpt2(pt1() As Double, pt2() As Double) As Double() Dim x1 As Double, y1 As Double, z1 As Double x = (pt1(0) + pt2(0)) / 2 y = (pt1(1) + pt2(1)) / 2 z = (pt1(2) + pt2(2)) / 2 midpt2 = pt(x, y, z) End Function Function dir_cosines1(pt1() As Double) As Double() Dim cos_alpha As Double, cos_beta As Double, cos_gamma As Double Dim d As Double d = dist1(pt1) If d = 0 Then dir_cosines1 = pt(0, 0, 0) Exit Function End If cos_alpha = pt1(0) / d cos_beta = pt1(1) / d cos_gamma = pt1(2) / d dir_cosines1 = pt(cos_alpha, cos_beta, cos_gamma) End Function Function dir_cosines2(pt1() As Double, pt2() As Double) As Double() Dim cos_alpha As Double, cos_beta As Double, cos_gamma As Double Dim d As Double d = dist1(pt1) If d = 0 Then dir_cosines2 = pt(0, 0, 0) Exit Function End If cos_alpha = (pt2(0) - pt1(0)) / d cos_beta = (pt2(1) - pt1(1)) / d cos_gamma = (pt2(2) - pt1(2)) / d dir_cosines2 = pt(cos_alpha, cos_beta, cos_gamma) End Function Function dir_angle(dir_cosine As Double) As Double dir_angle = WorksheetFunction.Acos(dir_cosine) dir_angle = rad2deg(dir_angle) End Function Function add_vectors(pt1() As Double, pt2() As Double) As Double() add_vectors = pt(pt1(0) + pt2(0), pt1(1) + pt2(1), pt1(2) + pt2(2)) End Function Function mult_vector(n As Double, pt1() As Double) As Double() mult_vector = pt(n * pt1(0), n * pt1(1), n * pt1(2)) End Function

Sub test5() Call Connect_Acad pt1 = pt(2, 4, 6) pt2 = pt(1, 9, 10) line1 pt1 line1 pt2 line2 midpt1(pt1), midpt1(pt2) Dim cosines() As Double cosines = dir_cosines1(pt1) pt3 = mult_vector(10, cosines) 'makes a line 10 in length along same line as pt1 line1 pt3 'alpha angle Debug.Print dir_angle(cosines(0)) End Sub Sub test6() Call Connect_Acad pt1 = pt(5, 1, 2) pt2 = pt(1, 2, 3) pt3 = add_vectors(pt1, pt2) line1 pt1 line3 pt1, pt2 line1 pt3 acadApp.Update End Sub