# Equations of Lines in Space

In 2D coordinates, AX + BY + C = 0 is the equation of a line. In 3D coordinates, this equation represents a plane. In 3D coordinates its not possible to specify a line by a single equation. A 3D line is represented by 3 equations, one for each x,y and z.

A straight line in space is completely determined by two points. It is also completely determined with a single point and a set of direction numbers. The direction numbers are the difference of the coordinates over any segment. Direction numbers come in sets of three. Its the same idea as a vector. A line has an infinite amount of direction number sets, all of them proportional. Just as you can multiply a vector by a scalar, and obtain another vector parallel but with a different length, you can multiply direction numbers by a scalar, call it t, and obtain further points on the same line.

If two points are given, (x1,y1,z1) and (x2,y2,z2), direction numbers are (x2-x1, y2-y1, z2-z1). These are often referred to as (a,b,c).

Either point can be used for the given point

X = x1 + at
Y = y1 + bt
Z = z1 + ct

To create an unending line in both directions, t takes on values between negative and positive infinity.

if we take an example, let one point P1 be the origin and the other point be (2,3,4). use P1 for the given point and (2,3,4) for (a,b,c)

X = 2t
Y = 3t
Z = 4t

the length of a line segment is the sq root of the sum of the coordinate deltas squared, so Len (2,3,4) is 29^1/2

$Len = \sqrt{x^2 + y^2 + z^2} = \sqrt{4 + 9 +16} = \sqrt{29}$

when t = 0, the point on the line is the origin. When t=1, the point is (2,3,4).

when
$Len = \sqrt{29}$

$t = 1$

so if

$Len = 1$

$t = \frac{1} {\sqrt{29}}$

when the line segment is 1, the coordinates are the direction cosines. the angle between the line and each of the coordinate axes can be found by taking the ArcCosine.

to put an arrowhead on a 3D vector, i insert an arrowhead block. I wanted to draw and do a revolve, but i was not initially able to find the activex method for revolve, so insert a block is the standby. i drew the cone shape the same size as dimension arrowheads so the scale factor works in a similar way. the insertion point is the head of the vector. we need the angle. i pass a direction vector, which is a parallel vector any length. normally i will just pass the same vector, but sometimes like when constructing an XYZ axes it is just as convenient to pass a unit vector.

Sub arr(pt1() As Double, D() As Double)
‘3D arrow
‘pt1 is location of the arrow
‘D is direction vector

the direction cosines of the direction vector are the familiar array of 3 doubles.

Dim dir_cos() As Double ‘direction cosines
dir_cos = ret_3D_angle(D)

the function ret_3D_angle takes one parameter, the direction vector, calculates the length, divides the x,y,z values by the length, and returns all 3 together in an array, just like a point.

the direction cosine for the x axis – the x coordinate for the direction vector at the place where the length is one – is used and the angle found for autocad to use later.

Dim alpha As Double
alpha = WorksheetFunction.Acos(dir_cos(0))

we have not passed in the actual tail coordinate of the vector we are trying to arrow. we have passed in the head coordinate and a vector parallel. the direction vector is positionless. its just 3 numbers. if we subtract those from the head coordinates, we will have a second point on the vector.

when we do that we have enough coordinates to change the user coordinate system, ucs in autocad, to a plane defined by the two lines, the vector itself and a line from the tail point just calculated parallel to the x-axis.

First we insert the arrowhead at rotation zero at the world coordinate system. then change the user coordinate system to the one defined by our vector and a line parallel to the x-axis. when you rotate an object, it rotates around a line perpendicular to the user coordinate system. so in effect by changing the user coordinate system, we have already made one rotation, even though we have not applied it yet. now rotate the arrowhead by the insertion point through alpha radians that we previously calculated. that completes the 3D arrow rotation.

Even though there are 3 angles from a vector to each of the axes, any two of them determine the third.

here is a diagram i did a while back on the arrowhead rotation problem.

x1,y1, z1 is any valid point on the vector which we have found above. to create a new ucs, a new origin is located, then a point on the new x-axis, and a point on the new y-axis. they must form a right angle. the new origin can be assembled from the head and tail coordinates. the new x-axis point can just add one value for x, and the new y-axis can use the head coordinates. some special error checking has to occur when the arrow is on the x-axis.


Sub arr(pt1() As Double, D() As Double)
'3D arrow
'pt1 is location of the arrow
'D is direction vector
Dim x1 As Double, y1 As Double, z1 As Double
Dim x2 As Double, y2 As Double, z2 As Double
Dim origin() As Double, xAxis() As Double, yAxis() As Double

Dim dir_cos() As Double  'direction cosines
dir_cos = ret_3D_angle(D)

Dim alpha As Double
alpha = WorksheetFunction.Acos(dir_cos(0))

Dim blkname As String
If sc = 0 Then sc = 1

'need an illustration
'pt1 is the location for the arrowhead
'D is the direction vector
'the new origin is x from pt1 and y and z calculated from tail of D

'transfer pt1 to x2,y2,z2
x2 = pt1(0)
y2 = pt1(1)
z2 = pt1(2)

' direction vector is positionless
' so we in effect put it at head and find tail
x1 = x2 - D(0)
y1 = y2 - D(1)
z1 = z2 - D(2)

' the new origin and new xaxis can be calculated
' the new yaxis is the tip of the arrow
origin = pt(x2, y1, z1)
xAxis = pt(x2 + 1, y1, z1)
yAxis = pt1
set_wcs  ' make sure we insert at world ucs

Set blkref = acadDoc.ModelSpace.InsertBlock(pt1, blkname, sc, sc, sc, 0)

'error when d(1) = 0 ucs yaxis is same as origin
'when alpha = 0 dont need to rotate
'when alpha = pi dont need to change ucs
'On Error Resume Next

If dir_cos(0) = 1 Then Exit Sub

If dir_cos(0) <> -1 Then
Call set_ucs(origin, xAxis, yAxis, "UCS_alpha")
End If

blkref.Rotate pt1, alpha
set_wcs

End Sub

Function ret_3D_angle(D() As Double) As Double()
'D is direction vector
'returns an array of 3 doubles that contain the direction cosines
Dim vector_len As Double
Dim pt1() As Double
Dim A As Double, B As Double, C As Double

vector_len = leng(D)

If vector_len = 0 Then
MsgBox "zero vector in ret_3D_angle"
Exit Function
End If

A = D(0) / vector_len
B = D(1) / vector_len
C = D(2) / vector_len

pt1 = pt(A, B, C)
ret_3D_angle = pt1

End Function

Sub set_ucs(origin() As Double, xAxis() As Double, yAxis() As Double, strName As String)

End Sub

Sub set_wcs()

Dim pt0() As Double, ptx() As Double, pty() As Double

pt0 = pt(0, 0, 0)
ptx = pt(1, 0, 0)
pty = pt(0, 1, 0)

End Sub



# Planes

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

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

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

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

Dim regionobj As Variant
regionobj(0).EntityTransparency = 90

End Sub


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

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

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

Dim regionobj As Variant
regionobj(0).EntityTransparency = g_transparency

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

End Sub


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

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

Set lines(0) = pline

Dim regionobj As Variant
regionobj(0).EntityTransparency = g_transparency

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

End Sub


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

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

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

Sub test_plane5()
init
Dim x As Double

For x = 1 To 9
pt1 = pt(x, ymin, zmin)
pt2 = pt(x, ymax, zmin)
pt3 = pt(x, ymax, zmax)
pt4 = pt(x, ymin, zmax)

plane_4pt pt1, pt2, pt3, pt4, x
Next x
Update
End Sub


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

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

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

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

Sub test_plane8()
init

xplane 2, "1"
yplane 1, "2"
zplane -2, "3"

Update
End Sub

Sub xplane(x As Double, strlayer As String)
Dim y1 As Double, y2 As Double
Dim z1 As Double, z2 As Double
Dim pts As Variant

y1 = ymin: y2 = ymax
z1 = zmin: z2 = zmax

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

Sub yplane(y As Double, strlayer As String)
Dim x1 As Double, x2 As Double
Dim z1 As Double, z2 As Double
Dim pts As Variant

x1 = xmin: x2 = xmax
z1 = zmin: z2 = zmax

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

Sub zplane(z As Double, strlayer As String)
Dim x1 As Double, x2 As Double
Dim y1 As Double, y2 As Double
Dim pts As Variant

x1 = xmin: x2 = xmax
y1 = zmin: y2 = zmax

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

Sub draw_3D_array(ar As Variant)
Dim pts() As Double
Dim i As Integer
Dim lower As Integer, upper As Integer
lower = LBound(ar)
upper = UBound(ar)

ReDim pts(lower To upper)
For i = lower To upper
pts(i) = ar(i)
Next i

g_3D_pline.Closed = True
g_3D_pline.Update
End Sub

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

Dim regionobj As Variant
regionobj(0).EntityTransparency = g_transparency

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



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

Ax + By + D = 0

in 3D space, this is a plane.

the standard equation of a plane in 3D space is

Ax + By + Cz + D = 0

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

the equation can be rewritten to

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


Sub test_plane9()
init

xyplane -4, 2, 2, "4"
xyplane 3, 2, -2, "5"

Update
End Sub

Sub xyplane(A As Double, B As Double, D As Double, strlayer As String)
Dim x1 As Double, x2 As Double
Dim y1 As Double, y2 As Double
Dim z1 As Double, z2 As Double
Dim pts As Variant

z1 = zmin: z2 = zmax
x1 = xmin: x2 = xmax

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

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


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

set TRANSPARENCYDISPLAY to 1

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

remember, set Visual Style not to 2D wireframe

# A little Problem with Arrowheads

we will get to that later.

Plotting a plane

Ax + By + Cz + D = 0

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

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

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

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

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

# Vectors and Geometry

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

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

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

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

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

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

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

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

Vector algebra can be used to prove and illustrate geometry.

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

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

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

I had trouble with this one. The altitude of a triangle is a line from a vertex perpendicular to the other side. The 3 altitudes intersect at a point called the orthocenter. Prove this by finding the intersection of two altitudes and show the third one goes thru the point and is perpendicular to the third side. I could not figure out how to get vector h. I could use actual data to prove it for this one specific case, but not a general vector equation. i believe solution lies with the similarity of triangles – the projection of AB on BC at P is the same as the projection of BH on BC at P, so that AB dot BC is equal to BH dot BC. and the same argument for AB on AC. In lieu of that, i show the drawing of the figure in autocad VBA.

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

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

slope = tan theta = delta y / delta x

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

theta = ATN (slope)

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

code after the picture


Sub test7()
'5 p30 altitude of triangle from vertex to perpendicular
init
'orthocenter
Dim ptH() As Double
'lines
'slopes
Dim m_AB As Double, m_BC As Double, m_CA As Double
'points
Dim ptA() As Double, ptB() As Double, ptC() As Double
Dim ptP() As Double, ptQ() As Double, ptR() As Double

ptA = pt(2, 1, 0)
ptB = pt(9, 3, 0)
ptC = pt(3, 6, 0)

Set AB = line1(ptA, ptB)
Set BC = line1(ptB, ptC)
Set CA = line1(ptC, ptA)

m_AB = slope(ptA, ptB)
m_BC = slope(ptB, ptC)
m_CA = slope(ptC, ptA)

Set AP = line3(ptA, (-1 / m_BC), 5)
Set BQ = line3(ptB, (-1 / m_CA), -5)
Set CR = line3(ptC, (-1 / m_AB), -5)

ptH = intersectWith(AP, BQ)

AP.EndPoint = ptH
BQ.EndPoint = ptH
CR.EndPoint = ptH

' txt1 "A", ptA, 0.375
' txt1 "B", ptB, 0.375
' txt1 "C", ptC, 0.375
' txt1 "H", ptH, 0.375

ptP = intersectWith(AP, BC)
ptQ = intersectWith(BQ, CA)
ptR = intersectWith(CR, AB)

AP.EndPoint = ptP
BQ.EndPoint = ptQ
CR.EndPoint = ptR

Update
End Sub

Function line1(startpt() As Double, endpt() As Double, Optional strlayer As Variant) As AcadLine

If Not IsMissing(strlayer) Then
line1.Layer = strlayer
End If

g_pt = endpt
End Function

Function line3(pt1() As Double, slope As Double, leng As Double) As AcadLine
Dim pt2() As Double, theta As Double
theta = Atn(slope)

g_pt = pt2
End Function

Function slope(pt1() As Double, pt2() As Double) As Double
Dim x As Double, y As Double, z As Double
y = pt2(1) - pt1(1)
x = pt2(0) - pt1(0)

If x = 0 Then
MsgBox "div by zero in slope"
Exit Function
Else
slope = y / x
End If

End Function

Dim ptH(0 To 2) As Double
Dim intpoints As Variant

intpoints = L1.intersectWith(L2, acExtendBoth)

' copied changed from autocad activex help for Intersectwith
Dim I As Integer, j As Integer

If VarType(intpoints) <> vbEmpty Then
For I = LBound(intpoints) To UBound(intpoints)

ptH(0) = intpoints(j)
ptH(1) = intpoints(j + 1)
ptH(2) = intpoints(j + 2)

I = I + 2
j = j + 3
Next
Else
MsgBox "did not find intersect"
End If

intersectWith = ptH

End Function



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

code to draw (not prove) after the picture


Sub test8()
'6 p30 perpendicular bisector of 3 sides of triangle are concurrent
init

'circumcenter
Dim ptK() As Double
'lines
'slopes
Dim m_AB As Double, m_BC As Double, m_CA As Double
'points
Dim ptA() As Double, ptB() As Double, ptC() As Double
Dim ptP() As Double, ptQ() As Double, ptR() As Double

ptA = pt(2, 1, 0)
ptB = pt(9, 3, 0)
ptC = pt(3, 6, 0)

Set AB = line1(ptA, ptB)
Set BC = line1(ptB, ptC)
Set CA = line1(ptC, ptA)

m_AB = slope(ptA, ptB)
m_BC = slope(ptB, ptC)
m_CA = slope(ptC, ptA)

ptP = midpoint(ptB, ptC)
ptQ = midpoint(ptC, ptA)
ptR = midpoint(ptA, ptB)

Set PK = line3(ptP, (-1 / m_BC), 5)
Set QK = line3(ptQ, (-1 / m_CA), -5)
Set RK = line3(ptR, (-1 / m_AB), -5)

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

Update
End Sub


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


Sub test10()
'8 p30 lines joining midpoints of opposite sides of a quadrilateral bisect each other
init

Dim ptZ() As Double
'lines

Dim ptA() As Double, ptB() As Double, ptC() As Double, ptD() As Double
Dim ptP() As Double, ptQ() As Double, ptR() As Double, ptS() As Double

ptA = pt(2, 8, 0)
ptB = pt(10, 7, 0)
ptC = pt(12, 2, 0)
ptD = pt(1, 3, 0)

Set AB = line1(ptA, ptB)
Set BC = line1(ptB, ptC)
Set CD = line1(ptC, ptD)
Set DA = line1(ptD, ptA)

ptP = midpoint(ptA, ptB)
ptQ = midpoint(ptB, ptC)
ptR = midpoint(ptC, ptD)
ptS = midpoint(ptD, ptA)

Set PR = line1(ptP, ptR)
Set QS = line1(ptQ, ptS)

txt1 "A", ptA, 0.375
txt1 "B", ptB, 0.375
txt1 "C", ptC, 0.375
txt1 "D", ptD, 0.375

txt1 "P", ptP, 0.375
txt1 "Q", ptQ, 0.375
txt1 "R", ptR, 0.375
txt1 "S", ptS, 0.375

ptZ = intersectWith(PR, QS)
txt1 "Z", ptZ, 0.375

Update
End Sub


# Vectors 3

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

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

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

Draw(vec) Draws vector in autocad as simple line

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

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

this is used as the basic vector creation function.

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

Function vec(x As Double, y As Double, z As Double) As Double()
Dim pnt(0 To 2) As Double
pnt(0) = x: pnt(1) = y: pnt(2) = z
vec = pnt
End Function

Function plus(u() As Double, v() As Double) As Double()
Dim w(0 To 2) As Double
w(0) = u(0) + v(0)
w(1) = u(1) + v(1)
w(2) = u(2) + v(2)

plus = w
End Function

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

scalar = w
End Function

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

minus = w
End Function

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

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

leng = w
End Function

Function unitv(u() As Double) As Double()
Dim w() As Double
Dim L As Double

L = leng(u)
w = scalar(1 / L, u)

unitv = w
End Function

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

dist = L
End Function

Function angle(u() As Double, v() As Double) As Double
Dim Dot_UV As Double
Dim len_U As Double
Dim len_V As Double
Dim cos_theta As Double

Dot_UV = dot(u, v)
len_U = leng(u)
len_V = leng(v)

cos_theta = Dot_UV / (len_U * len_V)

angle = WorksheetFunction.Acos(cos_theta)
End Function

Function ortho(u() As Double, v() As Double) As Boolean
Dim w As Double
w = dot(u, v)

If w = 0 Then
ortho = True
Else
ortho = False
End If
End Function

Function proj(u() As Double, v() As Double) As Double()
Dim w() As Double
Dim x As Double
Dim Dot_UV As Double
Dim Dot_UU As Double

x = Dot_UV / Dot_UU
w = scalar(x, u)

proj = w
End Function

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

neg = w
End Function



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

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


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

Sub draw(vec() As Double, startpt() As Double, Optional strlayer As Variant)
Dim endpt() As Double

endpt = pt(vec(0) + startpt(0), vec(1) + startpt(1), vec(2) + startpt(2))

If Not IsMissing(strlayer) Then
lineobj.Layer = strlayer
End If

g_pt = endpt

End Sub


# Acad Table — Array — Excel Sheet

EXCEL — ARRAY — ACAD TABLE

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

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

We need 4 basic methods.

Excel range to array
Array to excel range

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

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

Array = range
Or
Range = array

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

The four main sub/functions are –

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

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

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

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

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

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

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

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

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

xl_to_arr = rng

End Function

Sub arr_to_xl(arr As Variant, rng As Range)
Dim rows As Integer, cols As Integer
rows = UBound(arr, 1) - LBound(arr, 1) + 1
cols = UBound(arr, 2) - LBound(arr, 2) + 1

'resize the range to be same as array
Set rng = rng.Resize(rows, cols)

rng.Value = arr
'data is on the sheet

End Sub

Dim r As Integer, c As Integer
Dim rows As Integer, cols As Integer

rows = tbl.rows
cols = tbl.Columns

Dim arr As Variant
ReDim arr(1 To rows, 1 To cols)

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

End Function

Dim rowLbound As Integer, rowUbound As Integer
Dim colLbound As Integer, colUbound As Integer
Dim rows As Integer, cols As Integer

rowLbound = LBound(arr, 1)
rowUbound = UBound(arr, 1)
colLbound = LBound(arr, 2)
colUbound = UBound(arr, 2)

rows = rowUbound - rowLbound + 1
cols = colUbound - colLbound + 1

tbl.rows = rows
tbl.Columns = cols

Dim r As Integer, c As Integer

If rowLbound <> 1 And colLbound <> 1 Then
MsgBox "Lbound not eq 1 in arr to acadtbl, exiting"
Exit Sub
End If

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

End Sub



i use a couple globals in the calling programs.


Public g_arr As Variant

Sub tbl_to_xl()

Set g_tbl = get_table

If g_tbl Is Nothing Then
'MsgBox "table is nothing"
Exit Sub
End If

Call arr_report(g_arr)

Dim ws1 As Worksheet, rng As Range
Set ws1 = ThisWorkbook.Sheets("Chan_List")
Set rng = ws1.Range("A1")

Call arr_to_xl(g_arr, rng)

ws1.Activate
End Sub

Sub xl_to_tbl()

If g_tbl Is Nothing Then
Set g_tbl = get_table
End If

Dim ws1 As Worksheet, rng As Range
Set ws1 = ThisWorkbook.Sheets("Chan_List")
Set rng = ws1.Range("A1")
Set rng = rng.CurrentRegion

g_arr = xl_to_arr(rng)

Call arr_report(g_arr)

End Sub

Dim pt() As Double
Dim obj As Object
On Error Resume Next

acadDoc.Utility.GetEntity obj, pt, "Select a table"

If Err <> 0 Or obj.EntityType <> acTable Then
Err.Clear
MsgBox "table not selected"
Exit Function
End If

On Error GoTo 0

If obj.EntityType = acTable Then
Set get_table = obj
End If

End Function

Sub arr_report(arr As Variant)

Dim rowLbound As Integer, rowUbound As Integer
Dim colLbound As Integer, colUbound As Integer
Dim rows As Integer, cols As Integer

rowLbound = LBound(arr, 1)
rowUbound = UBound(arr, 1)
colLbound = LBound(arr, 2)
colUbound = UBound(arr, 2)

rows = rowUbound - rowLbound + 1
cols = colUbound - colLbound + 1

Debug.Print "arr: " & IsArray(arr)
Debug.Print "arr: " & VarType(arr)
Debug.Print "arr: " & TypeName(arr)

Debug.Print "row : " & rowLbound & " to "; rowUbound
Debug.Print "col : " & colLbound & " to "; colUbound
Debug.Print "rowcount: " & rows
Debug.Print "colcount: " & cols

Debug.Print

End Sub



# A Better More Complex Text Class

The simple Text class in the previous post does not link to the actual autocad text object, which makes it not fully useful, but it shows the class technique with simple variables of strings and numbers. The autocad text object returned by AddText can also be an object variable in the properties list. Addtext only requires 3 input variables, the string, the insert point, and the text height. Alignment has to be applied after text creation, so the object variable has to be available. the textstyle and layer of the new text object inherit the current autocad settings at time of creation, but alternatively they could be applied just to the text object. A user might be fine with the class changing the textstyle, but changing the layer if he is drawing lines everytime he needs text might not be welcome.

to implement a class where the variables can be set either before or after the actual AddText creation takes a little bit of thought. The first task is to keep the variables involved in an organized list. an excel sheet is a good place to do that. The 3 variables required by addtext are listed first, and the others selected to be managed follow. i only have 3 others, the style, layer and alignment. because of the way alignment works, it actually involves two variables.

because everytime a variable is set, the class not only needs to change it, but also it needs to update the autocad drawing – if the autocad text object has been created – there are no longer any public variables. so the private variables have your arcane wordy names, like m_stylename while the Let and Get that control it will have programmer friendly names like Style.

The sub class_initialize that runs everytime a Text object is created sets up default values.

the print subs call sub update_text_props which applies all properties that are not the 3 essentials input to AddText.

when a property is changed, the Let procedure for that property has to change the private variable, then check to see if a text object has been created yet, and if so, apply the new property value to the text in autocad. a simple Function IsTxt returns a boolean true or false.

keep the variable types straight. the autocad object has its must have list of properties. the module has its private list of variables which mostly correspond. the LET and GET procedures are what the programmer will see in the calling program.

with a good structure you can make a partial implementation and add further text object properties later. I did not use obliqueangle, rotation, scalefactor, handle or several others.

Alignment was the most complicated, but its nearly fully implemented here. there are 15 alignment options. each line of text has 4 horizontal lines, top, middle, baseline and bottom. each of those lines has left, center and right positions. thats 12. Baseline Left is the default. There are two more options called Fit and Align. these are the only two not fully implemented, but if you are interested, its mostly done. then there is another one called Middle, that i have not tried to see how it differs from Middle Center yet. Left, Center and Right which all work from Baseline are probably enough for me. I used the same codes that the autocad drawing editor shows at the command line. The enumerated constants are buried in the procedure.

i have left the style loading routine without further review. This might not be its final resting place.

no guarantee this is flawless, but its at least a second generation.

hopefully this will be a useful way to encapsulate the knowledge required to ADDTEXT.

first a screenshot of the excel variable note page. then the code.

Option Explicit

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

'these 3 are required by addText
Private m_textstring As String
Private m_insertpt() As Double
Private m_height As Double

'these change the text object after it is created
'but they can be set either before or after creation

Private m_stylename As String
Private m_layer As String
Private m_alignment As String

''example usage
'Sub test8()
''    Call insert_delete
''    Dim str As String
''
''Dim txt1 As New clsText
''    txt1.str = "some text here middle right justify"
''    txt1.insertPt = pt(4, 2, 0)
''    txt1.ht = 0.25
''    txt1.style = "ArialN"
''    txt1.layer = "Bold"
''    txt1.Alignment = "MR"
''    'MsgBox "middle right"
''
''    txt1.print1
''
''Dim txt2 As New clsText
''    'uses class defaults
''    txt2.print1
''
''    txt2.str = "some text here middle left justify"
''    txt2.insertPt = pt(4, 2, 0)
''    txt2.ht = 0.25
''    txt2.style = "RomanS"
''    txt2.layer = "4"
''    txt2.Alignment = "ML"
''    'MsgBox "middle left"
''
'End Sub

Private Sub Class_Initialize()
m_insertpt = pt(0, 0, 0)
m_textstring = "some text"
m_height = 0.125
m_stylename = "Standard"
m_layer = "0"
m_alignment = "L"

'MsgBox "initialize"
End Sub

Private Sub Class_Terminate()
'MsgBox "terminate"
End Sub

Function istxt() As Boolean
If m_txt Is Nothing Then
istxt = False
Else
istxt = True
End If
End Function

Private Sub update_text_props()
'called by print subs only
'assume m_txt is always valid

m_txt.stylename = m_stylename
m_txt.layer = m_layer
Me.Alignment = m_alignment
End Sub

Sub print1()
update_text_props
End Sub

Sub print2(str As String, ptx() As Double, dblheight As Double)
update_text_props
End Sub

Sub print3(str As String)
Dim linefactor As Double
linefactor = 1.5 * m_height
m_textstring = str
m_insertpt = pt(m_insertpt(0), m_insertpt(1) - linefactor, m_insertpt(2))

update_text_props
End Sub

Public Property Get str() As String
str = m_textstring
End Property

Public Property Let str(ByVal str1 As String)
m_textstring = str1

If istxt Then
m_txt.textstring = str1
End If
End Property

Public Property Get insertPt() As Double()
insertPt = m_insertpt
End Property

'arrays are always passed by reference
Public Property Let insertPt(ByRef ptx() As Double)
m_insertpt = ptx

If istxt Then
m_txt.insertionpoint = ptx
End If
End Property

Public Property Get ht() As Double
ht = m_height
End Property

Public Property Let ht(ByVal dblheight As Double)
m_height = dblheight

If istxt Then
m_txt.height = dblheight
End If
End Property

Public Property Get style() As String
style = m_stylename
End Property

Public Property Let style(ByVal str1 As String)
m_stylename = str1

If istxt Then
m_txt.stylename = str1
End If
End Property

Sub newstyle(strstylename As String)
On Error Resume Next

If Err Then
Select Case strstylename

Case "Arial"
new_textstyle "Arial", "Arial"

Case "ArialN"
new_textstyle "Arial_N", "Arial Narrow"

Case "Calibri"
new_textstyle "Calibri", "Calibri"

Case "Cambria"
new_textstyle "Cambria", "Cambria"

Case "Helvetica"
new_textstyle "Helvetica", "Swis721 BT"

Case "Palatino"
new_textstyle "Palatino", "Palatino Linotype"

Case "Tahoma"
new_textstyle "Tahoma", "Tahoma"

Case "Verdana"
new_textstyle "Verdana", "Verdana"

Case "Math"
new_textstyle "Symath_IV50", "Symath_IV50"

Case Else
MsgBox "Style value not in my list"
Exit Sub

End Select
End If

m_stylename = strstylename

End Sub

Private Sub new_textstyle(str_stylename As String, str_typeface As String)

Dim Bold As Boolean, Italic As Boolean
Dim lngchar As Long, lngpitch As Long
lngchar = 0
lngpitch = 34 'i am sure this is not meaningless but this is typ(swiss 32 variable 2)
Bold = False
Italic = False

'new style is added with no font information
'autocad assigns defaults similar or same as standard

newstyle.SetFont str_typeface, Bold, Italic, lngchar, lngpitch

End Sub

Public Property Get layer() As String
layer = m_layer
End Property

Public Property Let layer(ByVal str1 As String)
m_layer = str1

If istxt Then
m_txt.layer = m_layer
End If
End Property

Public Property Get Alignment() As String
Alignment = m_alignment
End Property

Public Property Let Alignment(ByVal str1 As String)
m_alignment = str1

Dim align_num As Integer

Select Case str1

Case "L"
align_num = acAlignmentLeft
'this is the default - baseline left
'if you set textalignment property at default you get error -
'not applicable to set textalignmentpoint
'ie
Exit Property

Case "C"
align_num = acAlignmentCenter

Case "R"
align_num = acAlignmentRight

Case "AL"
align_num = acAlignmentAligned
'not fully implemented until
'textalignmentpoint input is enabled

Case "M"
align_num = acAlignmentMiddle

Case "F"
align_num = acAlignmentFit
'not fully implemented until
'textalignmentpoint input is enabled

Case "TL"
align_num = acAlignmentTopLeft

Case "TC"
align_num = acAlignmentTopCenter

Case "TR"
align_num = acAlignmentTopRight

Case "ML"
align_num = acAlignmentMiddleLeft

Case "MC"
align_num = acAlignmentMiddleCenter

Case "MR"
align_num = acAlignmentMiddleRight

Case "BL"
align_num = acAlignmentBottomLeft

Case "BC"
align_num = acAlignmentBottomCenter

Case "BR"
align_num = acAlignmentBottomRight

Case Else
MsgBox "error in text class alignment code"
'reset to valid default
m_alignment = "L"
Exit Property

End Select

If istxt Then
m_txt.Alignment = align_num
m_txt.textalignmentpoint = m_insertpt
End If

End Property