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