Find file
Fetching contributors…
Cannot retrieve contributors at this time
116 lines (96 sloc) 2.95 KB
' ChordLengthGizmo.rvb -- May 2005
' If this code works, it was written by Dale Fugier.
' If not, I don't know who wrote it.
' Works with Rhino 4.0.
Option Explicit
Sub ChordLengthGizmo
' Get first curve
Dim crv1: crv1 = SelectOpenCurve("First curve")
If IsNull(crv1) Then Exit Sub
' Get second curve
Dim crv2: crv2 = SelectOpenCurve("Second curve")
If IsNull(crv2) Then Exit Sub
' Bail if same curve
If crv1 = crv2 Then Exit Sub
' Get chord length
Dim length: length = Rhino.GetReal("Chord length")
If Not IsNumeric(length) Then Exit Sub
' Validate length
If Rhino.CurveLength(crv1) < length Or Rhino.CurveLength(crv2) < length Then
Rhino.Print "Specified chord length exceeds curve length."
Exit Sub
End If
' Reverse one of the curves if necessary
If Rhino.CurveDirectionsMatch(crv1, crv2) = False Then
Rhino.ReverseCurve crv1
End If
' Get parameter of starting points of curves
Dim dom1: dom1 = Rhino.CurveDomain(crv1)
Dim dom2: dom2 = Rhino.CurveDomain(crv2)
Dim t1: t1 = dom1(0)
Dim t2: t2 = dom2(0)
' Add first line
Rhino.EnableRedraw False
Dim curves()
Dim pt1: pt1 = Rhino.EvaluateCurve(crv1, t1)
Dim pt2: pt2 = Rhino.EvaluateCurve(crv2, t2)
Dim cnt: cnt = 0
ReDim Preserve curves(cnt)
curves(cnt) = Rhino.AddLine(pt1, pt2)
' Loop until finished
Dim bDone: bDone = False
While (bDone = False)
t1 = ChordLengthParameter(crv1, t1, length)
t2 = ChordLengthParameter(crv2, t2, length)
If IsNull(t1) Or IsNull(t2) Then
bDone = True
pt1 = Rhino.EvaluateCurve(crv1, t1)
pt2 = Rhino.EvaluateCurve(crv2, t2)
cnt = cnt + 1
ReDim Preserve curves(cnt)
curves(cnt) = Rhino.AddLine(pt1, pt2)
End If
If UBound(curves) > 0 Then
Dim i, arr(1)
For i = 0 To UBound(curves) - 1
arr(0) = curves(i)
arr(1) = curves(i+1)
Rhino.AddLoftSrf arr,,,3
End If
Rhino.EnableRedraw True
End Sub
Function ChordLengthParameter(crv, t, l)
' Default return value
ChordLengthParameter = Null
' Determine chord by intersecting a circle
' with the curve
Dim pt: pt = Rhino.EvaluateCurve(crv, t)
Dim cir: cir = Rhino.AddCircle(pt, l)
Dim ccx: ccx = Rhino.CurveCurveIntersection(crv, cir)
Rhino.DeleteObject cir
If Not IsArray(ccx) Then Exit Function
' Find the largest parameter
Dim i
For i = 0 To UBound(ccx)
If ccx(i,0) = 1 Then
If ccx(i,5) > t Then
ChordLengthParameter = ccx(i,5)
Exit Function
End If
End If
End Function
Function SelectOpenCurve(strPrompt)
Dim crv: crv = Rhino.GetObject(strPrompt, 4)
If IsNull(crv) Or Rhino.IsCurveClosed(crv) Then
SelectOpenCurve = Null
SelectOpenCurve = crv
End If
End Function