‘ 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
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)
dblAbsTol = Rhino.UnitAbsoluteTolerance
Form1.Label2.Visible = True
DoEvents
Rhino.enableredraw vbFalse
For i = 1 To 30
Form1.Label4.Caption = "Iteration [" + Trim(Str(i)) + "]"
DoEvents
arrCenter = Array(0, 0, 0)
xaxis = Array(Val(Text2.Text), 0, 0)
yaxis = Array(0, vertical_y_value, 0)
Rhino.addLine arrCenter, xaxis
aaxis_obj = Rhino.FirstObject
Rhino.addLine arrCenter, yaxis
baxis_obj = Rhino.FirstObject
Rhino.AddEllipse3Pt arrCenter, xaxis, yaxis
ellipse_obj = Rhino.FirstObject
radius = Val(Text4.Text)
circle_center = xaxis
arrPlane = Rhino.ViewCPlane
new_cplane = Rhino.MovePlane(arrPlane, circle_center)
circ_obj = Rhino.AddCircle(new_cplane, radius)
circle_obj = Rhino.FirstObject
arrCCX = Rhino.CurveCurveIntersection(ellipse_obj, circle_obj)
Rhino.UnselectAllObjects
circle_center = arrCCX(0, 1)
Rhino.deleteobject circ_obj
aintersect = False
m = 0
If Form1.Check2.Value = 1 Then
arrline(m) = Rhino.addLine(new_cplane(0), arrCCX(0, 1))
End If
Do While aintersect = False
m = m + 1
new_cplane = Rhino.MovePlane(new_cplane, circle_center)
circle_obj = Rhino.AddCircle(new_cplane, radius)
arrCCX1 = Rhino.CurveCurveIntersection(ellipse_obj, circle_obj)
arrCCX2 = Rhino.CurveCurveIntersection(baxis_obj, circle_obj)
Rhino.deleteobject circle_obj
If Form1.Check2.Value = 1 Then
arrline(m) = Rhino.addLine(new_cplane(0), arrCCX1(1, 3))
End If
If Not IsNull(arrCCX2) Then
x_val = (arrCCX1(1, 3)(0))
Label3.Caption = Str(vertical_y_value)
vertical_y_value = vertical_y_value + Abs(x_val)
If Abs(x_val) <= dblAbsTol Then
Form1.Label4.Caption = "Ellipse created inside tolerance [" + Str(dblAbsTol) + "]" + "->[" + Trim(Str(i)) + "] iterations"
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)
mirror2_objs = Rhino.MirrorObjects(mirror1_objs, arrCenter, yaxis, vbTrue)
Rhino.MirrorObjects mirror_objs, arrCenter, yaxis, vbTrue
End If
Exit For
End If
Rhino.deleteobject ellipse_obj
Rhino.deleteobject aaxis_obj
Rhino.deleteobject baxis_obj
If Form1.Check2.Value = 1 Then
For k = 0 To m
Rhino.deleteobject arrline(k)
Next
End If
aintersect = True
End If
Rhino.UnselectAllObjects
circle_center = arrCCX1(1, 3)
Loop
Next
Rhino.enableredraw vbTrue
DoEvents
Form1.Label2.Visible = False
End Sub