Euclid Book 1 Proposition 3

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

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

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

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

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

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

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

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


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

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

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

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


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

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

Dim r As Double
Dim intpts As Variant

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

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

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

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

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

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

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

lineAB.Delete
'circF.Delete

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

'labels
Dim th As Double
th = 1#

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

End Sub
Advertisements

Euclid Book 1 Proposition 2

Euclid’s 2nd proposition draws a line at point A equal in length to a line BC. It uses proposition 1 and is used by proposition 3. I tried to make a generic program I could use for both the primary job of illustrating the theorem and for the purpose of being used by subsequent theorems, but it is simpler to separate those into two sub procedures. The programming was pretty easy except when a line is extended to meet a circle, there are two intersections, and one of them has to be selected. A good illustration with labeled objects helps keep it straight.

In autocad 1-2 is not a problem. The solution would be to copy or move the line endpoint to endpoint. In Euclid, lines cannot be moved. The compass cannot be used to transfer a distance by being picked up off the page. In autocad items are rigid. When two objects the same are copied to the same location they exactly coincide. Euclid’s 4th Axiom is “Things that coincide with one another are equal to one another”. This has caused remarks as to its real meaning. If you cannot move an object to super-impose, how would you know, and even if you could move them, no physical object will perfectly cover another. This common belief, things that are the same coincide, is intended to point to ideal form, like we have in a cad program.

Sub prime_pr2()
'given ptA and lineBC call proposition2
Connect_Acad

Dim ptA(0 To 2) As Double
Dim ptB(0 To 2) As Double
Dim ptC(0 To 2) As Double

Dim Ax As Double, Ay As Double
Dim Bx As Double, By As Double
Dim Cx As Double, Cy As Double

Ax = rnddbl(0, 5)
Ay = rnddbl(0, 5)
Bx = rnddbl(6, 10)
By = rnddbl(0, 10)
Cx = rnddbl(6, 20)
Cy = rnddbl(15, 25)

Call pt(ptA, Ax, Ay, 0)
Call pt(ptB, Bx, By, 0)
Call pt(ptC, Cx, Cy, 0)

    Call pr2(ptA, ptB, ptC)
acadApp.Update
End Sub


Sub pr2(ptA() As Double, ptB() As Double, ptC() As Double)

Dim lineBC As AcadLine
Dim lineAB As AcadLine, lineAD As AcadLine, lineBD As AcadLine
Dim lineAL As AcadLine, lineBG As AcadLine
Dim circH As AcadCircle, circK As AcadCircle

Dim r As Double
Dim intpts As Variant

Dim ptD(0 To 2) As Double
Dim ptG(0 To 2) As Double
Dim ptL(0 To 2) As Double

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

'now we need Euclid 1-1 to draw equilateral triangle
Call pr2_pr1_sub(ptA, ptB)

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

Set lineAD = acadDoc.ModelSpace.AddLine(ptA, ptD)
Set lineBD = acadDoc.ModelSpace.AddLine(ptB, ptD)

 'find ptG, do lineBG
r = distance(ptB, ptC)
Set circH = acadDoc.ModelSpace.AddCircle(ptB, r)
intpts = lineBD.IntersectWith(circH, acExtendThisEntity)
Call intpts_eval(intpts)

'want ptG intersection farthest from ptD
If distance(ptD, ptG1) > distance(ptD, ptG2) Then
ptG(0) = ptG1(0)
ptG(1) = ptG1(1)
ptG(2) = ptG1(2)

Else
ptG(0) = ptG2(0)
ptG(1) = ptG2(1)
ptG(2) = ptG2(2)
End If

Set lineBG = acadDoc.ModelSpace.AddLine(ptB, ptG)

 'now find ptL, do lineAL
r = distance(ptD, ptG)
Set circK = acadDoc.ModelSpace.AddCircle(ptD, r)

intpts = lineAD.IntersectWith(circK, acExtendThisEntity)
Call intpts_eval(intpts)

'going to take the lesser y value
If ptG1(1) > ptG2(1) Then
ptG1(0) = ptG2(0)
ptG1(1) = ptG2(1)
ptG1(2) = ptG2(2)
End If

ptL(0) = ptG1(0)
ptL(1) = ptG1(1)
ptL(2) = ptG1(2)

Set lineAL = acadDoc.ModelSpace.AddLine(ptA, ptL)

'ptG1 is same as ptL
End Sub


Sub pr2_pr1_sub(ptA() As Double, ptB() As Double)
'just the bare necessities - no drawing - calculate vertex
Dim circD As AcadCircle, circE As AcadCircle

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

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

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

'going to take positive y value
'this is how i am passing back found vertex
If ptG2(1) > ptG1(1) Then
ptG1(0) = ptG2(0)
ptG1(1) = ptG2(1)
ptG1(2) = ptG2(2)
End If

circD.Delete
circE.Delete

End Sub

If Euclid had Autocad

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

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


Sub prime_pr1()
'given lineAB call proposition1
Connect_Acad

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

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

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


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

Dim r As Double
Dim intpts As Variant

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

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

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

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

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

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

End Sub



helper functions


Option Explicit

Public num_int_pts As Integer

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

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

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


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

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

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

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