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.

Advertisements

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

The Dot Product

Autocad does not have a 3D arc command and its kind of wild how hard it is to draw an arc on a sphere. I think we can do it, but there is a lot of theory involved, which is good because its fun and what else were you going to do? Googling the problem, the best solution I saw (which i won’t use here) was “ProjectGeometry” where a line drawn from point to point on the sphere is projected onto the solid sphere object and converted to an arc. I did not spend a lot of time looking for it, but I am not sure if that method is available in activeX. Its not an object type. Its a command, a written program in autocad, so its a manual technique. Although possibly you could use sendcommand or something similar.

To draw an arc on a sphere – two endpoints, center and radius will be the givens. Two vectors from 0,0,0 to the endpoints are drawn. The dot product, also called the scalar product of two vectors, has all the theory we need to construct a new ucs in the plane of the vectors and the arc we want to draw. Its a math topic in a beginning vectors class. The dot product is a calculation that projects a perpendicular from one vector to the other. The point that it touches becomes the origin of the new ucs. The new x-axis is defined by the endpoint of the vector, and the new y-axis is defined by the projecting vector endpoint. The 3 points must form a right angle, which they do. The dot product also gives us the included angle between the vectors, just from the endpoint coordinates. very nice.

There is no way to draw an arc that is not parallel to the current ucs, so you have to change the ucs. However all the other data that goes into creating an arc stays tied to the World ucs, as far as drawing in activeX is concerned. If you are drawing manually, autocad accomodates your desire to draw in the new ucs. 0,0,0 typed in at the command line is interpreted to be the new ucs origin. Activex generally ignores the ucs, except as it defines the drawing plane.

Draw an arc with any method then look at the arc in the properties window to see what data is read/write and what is grayed out. You can edit the center xyz coordinates, the radius, the start and end angle. Thats all. Those are the exact same prompts the activex addarc requires. Moving the center moves it parallel to its plane of creation. If the other data are changed, the shape of the curve is changed and new endpoints are calculated by autocad, but it stays parallel to the plane it was made in.

Startangle is a hard problem. With the dot product, we can calculate the included angle from the endpoints. We know the center and the radius. The startangle for the arc is not the angle from the current ucs. It is not the angle projected onto the world ucs. With 2D vectors, there is only one reference angle, the angle from the vector to the positive X axis. In the 2D plane autocad measures angles from the positive x-axis. The angle of a 3D vector is defined by the angle from the vector directly to each positive axis. The angle to the X-axis is called the Alpha angle. In the tilted ucs I did not see what the logic of startangle was. I drew an arc with startangle zero, and the arc touched down on the world x-axis. The startangle is the vector direction angle Alpha from the new x-axis directly to the world x-axis. But it is not that simple either. My vectors were 5,5,5 and -5,5,5. They were symmetrical across the z-axis, which made an alpha projection hit the x-axis. If the ucs has another twist, the alpha angle will extend to where it breaks the xy plane apparently.

I need to find the intersection of the ucs with the world xy plane. The only way i know how to do it right now is to draw an arc with startangle 0 and see where it starts. Pretty sure its a solvable problem.

(actually have ny and la backwards labeled. my latitude longtitude converter is not handling east west correctly, the arclength came out correct)

Sub A_scalar_dot_B(x1 As Double, y1 As Double, z1 As Double, x2 As Double, y2 As Double, z2 As Double)

Dim ptA() As Double
Dim ptB() As Double

Dim A_dot_B As Double
Dim len_A As Double
Dim len_B As Double
Dim cos_theta As Double
Dim theta As Double
Dim theta_deg As Double

Dim A_unit_vector() As Double
Dim A_unit_x As Double
Dim A_unit_y As Double
Dim A_unit_z As Double

Dim B_unit_vector() As Double
Dim B_unit_x As Double
Dim B_unit_y As Double
Dim B_unit_z As Double

Dim scalar_B_on_A As Double
Dim scalar_A_on_B As Double

Dim pt_scalar_B_on_A() As Double

ptA = pt(x1, y1, z1)
ptB = pt(x2, y2, z2)

A_dot_B = x1 * x2 + y1 * y2 + z1 * z2
len_A = (x1 ^ 2 + y1 ^ 2 + z1 ^ 2) ^ (1 / 2)
len_B = (x2 ^ 2 + y2 ^ 2 + z2 ^ 2) ^ (1 / 2)
cos_theta = A_dot_B / (len_A * len_B)
theta = WorksheetFunction.Acos(cos_theta)
theta_deg = rad2deg(theta)

A_unit_x = x1 / len_A
A_unit_y = y1 / len_A
A_unit_z = z1 / len_A

B_unit_x = x2 / len_B
B_unit_y = y2 / len_B
B_unit_z = z2 / len_B

scalar_B_on_A = len_B * cos_theta
scalar_A_on_B = len_A * cos_theta

pt_scalar_B_on_A = pt(A_unit_x * scalar_B_on_A, A_unit_y * scalar_B_on_A, A_unit_z * scalar_B_on_A)

ucs pt_scalar_B_on_A, ptA, ptB, "wow"

Debug.Print theta_deg

public_theta_deg = theta_deg

End Sub

Sub testconv()
Call Connect_Acad
  pt0 = pt(0, 0, 0)
 
  set_ucs 0, 0, 0, 1, 0, 0, 0, 1, 0, "world"
 
 pt1 = conv(40.713, 74.006, 3963)  'NEW YORK
 pt2 = conv(34.052, 118.244, 3963)  'LOS ANGELES
  'CONV IS PRELIMINARY
  
 line1 pt0, pt1
 line1 pt0, pt2
 
  Call A_scalar_dot_B(pt1(0), pt1(1), pt1(2), pt2(0), pt2(1), pt2(2))
  
  Dim r As Double
  r = 3963  'RADIUS IN MILES
     
     Dim alpha As Double
     alpha = 85.727
    ' alpha = 0
    'try 0, measure and input value
     
  arc1 pt0, r, alpha, alpha + public_theta_deg

Debug.Print pt1(0)
Debug.Print pt1(1)
Debug.Print pt1(2)

Debug.Print pt2(0)
Debug.Print pt2(1)
Debug.Print pt2(2)

acadApp.Update

End Sub

Spherical Coordinates

My goal is to draw on the sphere converting latitude longitude coordinates to xyz values. Once coordinates are calculated, every line on a sphere is an arc. To draw an arc with known endpoints, known radius and known center, you would think would be simple, but consider what if the points are inaccurate and an arc cannot be drawn. That is why the AddArc method requires a Center, a Radius, a Start Angle and an End Angle. It calculates the points. But notice, there is no opportunity to tilt the arc up into 3D space. It will lie in the XY plane. To draw an arc on a sphere from a center, a radius and two known points, a user coordinate system must be created containing the 3 points, and the angle between points has to be calculated. A UCS point set requires three points that form a right angle. the origin, one of the endpoints, and a normal point. There might be another problem – methods from VBA (ActiveX) generally ignore user coordinate systems and work only in World coordinate system, Autocad’s base of operation. However the help for addarc mentions the center is in WCS, but not the angles. I assume the angles are calculated from UCS. (update a few days later – they are not). Then the angle between points would be calculated from the X axis of the user coordinate system. I have not tried it yet.

Generally if an ActiveX method requires a point, its a WCS point. AddLine is a fully functional 3D command. It takes two 3D points as input. It does not matter what UCS is current. It ignores it. If VBA has the point 0,0,0 as the first point of a line, it starts the line at WCS 0,0,0 no matter where the origin is for the current UCS. That is not so at the command line, 0,0,0 typed at the command line to the line prompt is interpreted to be the origin of the current UCS.

Circle is a little different. you can draw circles at different Z elevations without changing the UCS from the command line, because the center can be any 3D point. You can do the same from VBA, but subsequent prompts and input do not allow you to tip the circle so that it is not parallel to the current UCS.

we need to survey our basic tools and see how they act and what they require.

we need some ucs tools and some viewpoint tools. viewpoint is somewhat more involved than ucs. it has more variables and finally whatever view is created has to be applied to the current viewport. for now i am going to rely on some simple macros and my 3Dconnexion mouse, which works great, the simple one.

The old viewpoint command, before the dialog box, just took a direction vector. such as “1,-1,1” for a southeast viepoint. We can throw that into a program quick if we need it. mostly i will probably rely on the mouse. but here is the macro sub using sendcommand. if you type VP at the command line and get the dialog, type -VP. if that doesnt work look at your pgp which is re-directing. this code works if -vp works at your command line.

Sub vp(str_vp As String)
Dim str As String
'these are commented out for reference 
'acadDoc.SendCommand "-vp" & vbCr & "-1,-1,1" & vbCr  'SW
'acadDoc.SendCommand "-vp" & vbCr & "1,-1,1" & vbCr  'SE
'acadDoc.SendCommand "-vp" & vbCr & "1,1,1" & vbCr  'NE
'acadDoc.SendCommand "-vp" & vbCr & "-1,1,1" & vbCr  'NW
'acadDoc.SendCommand "-vp" & vbCr & "0,0,1" & vbCr  'TOP
'acadDoc.SendCommand "-vp" & vbCr & "0,0,-1" & vbCr  'BOTTOM
'acadDoc.SendCommand "-vp" & vbCr & "-1,0,0" & vbCr  'LEFT
'acadDoc.SendCommand "-vp" & vbCr & "1,0,0" & vbCr  'RIGHT
'acadDoc.SendCommand "-vp" & vbCr & "0,-1,0" & vbCr  'FRONT
'acadDoc.SendCommand "-vp" & vbCr & "0,1,0" & vbCr  'BACK

 Select Case UCase(str_vp)
    Case "TOP"
    str = "0,0,1"
    
    Case "FRONT"
    str = "0,-1,0"
    
    Case "RIGHT"
    str = "1,0,0"
    
    Case "LEFT"
    str = "-1,0,0"
    
    Case "BACK"
    str = "0,1,0"
    
    Case "TOP_FRONT"
    str = "0,-1,1"
     
    Case "SW"
    str = "-1,-1,1"
    
    Case "SE"
    str = "1,-1,1"
    
    Case "NE"
    str = "1,1,1"
     
    Case "NW"
    str = "-1,1,1"
     
    Case "BOTTOM"
    str = "0,0,-1"
      
    Case Else
    Exit Sub
  End Select
 
acadDoc.SendCommand "-vp" & vbCr & str & vbCr
End Sub

next we need to survey our basic tools, line, circle, arc, polyline, and ucs with regard to how they work in 3D space. we will need some text labels, we will want to dimension in 3D. we can download the formulas to convert from latitude longitude to cartesian but we want to show how they are developed. The diameter of the earth is not constant. People who map for a living know exactly what the bulge is. we are going to assume a perfect sphere, but we will use a variable for the Radius so results will be general for a bowling ball or the earth.

once we have the autocad tools, we should be able to download some coordinates into excel and draw arcs between them from vba. assuming i can draw 3D arcs.