‘ Ellipse by chord height - Mike Dejanovic – no rights or lefts reserved.
‘ 06.05.2006
Dim k, m, i
Dim center, xaxis, circle_center, radius
Dim arrPlane, new_cplane, ellipse_obj, pt, aintersect
Dim apt ' aaxis point
Dim arrCCX, arrCCX1, arrCCX2, dblAbsTol
Dim circ_obj, aaxis_obj, baxis_obj
Dim arrline(512)
Dim mirror_objs As Variant
 
vertical_y_value = Val(Text3.Text) ' b-axis
dblAbsTol = Rhino.UnitAbsoluteTolerance ' rhino abs toler.
Form1.Label2.Visible = True
DoEvents
 
Rhino.enableredraw vbFalse
 
For i = 1 To 30 'main loop start max iterations
 
    Form1.Label4.Caption = "Iteration [" + Trim(Str(i)) + "]"
    DoEvents
    arrCenter = Array(0, 0, 0) 'start ellipse in 0,0,0
    xaxis = Array(Val(Text2.Text), 0, 0) 'ellipse a-axis
    yaxis = Array(0, vertical_y_value, 0) 'ellipse  b-axis
    
    Rhino.addLine arrCenter, xaxis 'add a-axis
    aaxis_obj = Rhino.FirstObject ' get a object
    Rhino.addLine arrCenter, yaxis ' add b-axis
    baxis_obj = Rhino.FirstObject ' get b object
    
    Rhino.AddEllipse3Pt arrCenter, xaxis, yaxis ' add initial ellipse
    ellipse_obj = Rhino.FirstObject ' get ellipse object
 
    radius = Val(Text4.Text) 'user input chord segment length (1.35)
    circle_center = xaxis ' coo for first circle
    arrPlane = Rhino.ViewCPlane 'get conctruction plane for circle creation
    new_cplane = Rhino.MovePlane(arrPlane, circle_center) ' move it to the circle center
    circ_obj = Rhino.AddCircle(new_cplane, radius) ' create tmp circle
    circle_obj = Rhino.FirstObject 'get tmp circle object
    arrCCX = Rhino.CurveCurveIntersection(ellipse_obj, circle_obj) ' get intersection of ellipse and cricle
    Rhino.UnselectAllObjects ' unselect allobject do we need this? perhaps not...
    circle_center = arrCCX(0, 1) ' get a new circle center from intersection point one UP
    Rhino.deleteobject circ_obj ' delete tmp circle
    aintersect = False ' do we have intersection with b-ellipse axis
    m = 0
    'if user selects show chord lines
    If Form1.Check2.Value = 1 Then
        arrline(m) = Rhino.addLine(new_cplane(0), arrCCX(0, 1)) ' add connection lines
    End If
    'eof user select show chord lines
    Do While aintersect = False ' second loop
        m = m + 1
        new_cplane = Rhino.MovePlane(new_cplane, circle_center) ' move plane again in the loop
        circle_obj = Rhino.AddCircle(new_cplane, radius) ' new tmp circle
        arrCCX1 = Rhino.CurveCurveIntersection(ellipse_obj, circle_obj) ' intersection ellipse and tmp circle
        arrCCX2 = Rhino.CurveCurveIntersection(baxis_obj, circle_obj) ' intersection b-axis and tmp circle
        Rhino.deleteobject circle_obj ' delete tmp circle
        'if user selects show chord lines
        If Form1.Check2.Value = 1 Then
            arrline(m) = Rhino.addLine(new_cplane(0), arrCCX1(1, 3)) ' add connection line
        End If
        'eof user select show chord lines
        If Not IsNull(arrCCX2) Then ' if we have intersection tmp circle and vertical b-axis
            x_val = (arrCCX1(1, 3)(0)) 'good' coz we are at 0,0,0 so we need only x length
            Label3.Caption = Str(vertical_y_value) ' show new b-axis length
            vertical_y_value = vertical_y_value + Abs(x_val) 'add x length to the b-length
            If Abs(x_val) <= dblAbsTol Then 'if we meet abs tolerance
                Form1.Label4.Caption = "Ellipse created inside tolerance [" + Str(dblAbsTol) + "]" + "->[" + Trim(Str(i)) + "] iterations"
                'if user selects show chord lines
                'mirror all the connection line we have connection line for 1/4 of ellipse
                If Form1.Check2.Value = 1 Then
                    ReDim mirror_objs(m)
                    For j = 0 To m
                        mirror_objs(j) = arrline(j)
                    Next
                    mirror1_objs = Rhino.MirrorObjects(mirror_objs, arrCenter, xaxis, vbTrue) 'mirror around xaxis
                    mirror2_objs = Rhino.MirrorObjects(mirror1_objs, arrCenter, yaxis, vbTrue) 'mirror around b axis
                    Rhino.MirrorObjects mirror_objs, arrCenter, yaxis, vbTrue ' mirro b axis again with initial objects
                End If
                'eof user selects show chord lines
        
        Exit For
        End If
        'delete not needed objects
        Rhino.deleteobject ellipse_obj
        Rhino.deleteobject aaxis_obj
        Rhino.deleteobject baxis_obj
        'delete all tmp connection lines
        If Form1.Check2.Value = 1 Then
            For k = 0 To m
                Rhino.deleteobject arrline(k)
            Next
        End If
        aintersect = True ' we have intersection with b axis
    End If
    Rhino.UnselectAllObjects ' all deseclect
    circle_center = arrCCX1(1, 3) ' new circle center = intersection point
    
Loop 'while
Next ' iteration for
Rhino.enableredraw vbTrue ' redraw
DoEvents
Form1.Label2.Visible = False ' wait off
 
End Sub