top of page
Writer's pictureDavid Mans

Evaluate Curve By Distance

šŸ’» Rhino 5

šŸ”¼ Rhino Script

šŸ› ļø Visual Basic

Ā 

This Rhino Script breaks a curve down into a series of equidistant points represented as lines. Starting from a series of origin options, start, middle, end, curve percentage, and user-specified point. The function housed in the script returns two array sets of points, one in the positive and one in the negative t directions where possible.

Ā 
Option Explicit
'Script written by <David Mans>
'Script copyrighted by <Neoarchaic Design>
'Script version Tuesday, January 06, 2009 8:42:52 PM
 
Call Main()
Sub Main()
    Dim strReturn, curve, distance, percent, origin
     
    curve = Rhino.GetObjects("Select Curve", 4)
    If isNull(curve) Then Exit Sub
     
    strReturn = Rhino.GetString("Evaluate Curve From ", "Start", array("Start", "Middle", "End", "Percent", "Point"))
    If isNull(strReturn) Then Exit Sub
     
    If strReturn = "Start" Then
        origin = Rhino.CurveDomain(curve)(0)
    ElseIf strReturn = "Middle" Then
        origin = Rhino.CurveDomain(curve)(1) * 0.5
    ElseIf strReturn = "End" Then
        origin = Rhino.CurveDomain(curve)(1)
    ElseIf strReturn = "Percent" Then
         
        percent = Rhino.GetReal("Percent", 50, 0, 100)
        If isNull(percent) Then Exit Sub
         
        If percent = 0 Then
            origin = Rhino.CurveDomain(curve)(0)
        Else
            origin = Rhino.CurveDomain(curve)(1) * (percent * 0.01)
        End If
    ElseIf strReturn = "Point" Then
        origin = Rhino.CurveClosestPoint(curve, Rhino.GetPointOnCurve(curve))
        If isNull(origin) Then Exit Sub
    End If
     
    distance = Rhino.GetReal("Division Length", 10)
    If isNull(distance) Then Exit Sub
     
     
    Dim i, j,k, evalCurve
     
    Call Rhino.EnableRedraw(False)
    For k = 0 To uBound(curve(k)) Step 1
        evalCurve = evalCrvByDist(curve(k), distance, origin)
         
        For i = 0 To 1 Step 1
            For j = 1 To uBound(evalCurve(i)) Step 1
                Call Rhino.AddTextDot(j, evalCurve(i)(j))
                Call Rhino.AddLine(evalCurve(i)(j - 1), evalCurve(i)(j))
            Next
        Next
    Next
    Call Rhino.EnableRedraw(True)
 
End Sub
Function evalCrvByDist(curve, distance, origin)
    evalCrvByDist = Null
    Dim i, j, k, r, s, t
    Dim sphere
    Dim tInt(), pt(), tempT(),pts(1)
    r = 0: s = 0
 
    For k = 0 To 1 Step 1
        t = origin
        r = 0
        ReDim Preserve pt(r)
        pt(r) = Rhino.EvaluateCurve(curve, t)
         
        Do
            j = 0
         
            ReDim tempT(0)
            ReDim Preserve tInt(r)
            sphere = Rhino.AddSphere(pt(r), distance)
            tInt(r) = Rhino.CurveSurfaceIntersection(curve, sphere)
            Call Rhino.DeleteObject(sphere)
         
            For i = 0 To uBound(tInt(r)) Step 1
                If k = 0 Then
                    If tInt(r)(i, 0) = 1 And tInt(r)(i, 5) > t Then
                        s = s + 1
                        ReDim Preserve tempT(j)
                        tempT(j) = tInt(r)(i, 5)
                        j = j + 1
                    End If
                Else
                    If tInt(r)(i, 0) = 1 And tInt(r)(i, 5) < t Then
                        s = s + 1
                        ReDim Preserve tempT(j)
                        tempT(j) = tInt(r)(i, 5)
                        j = j + 1
                    End If
                End If
            Next
         
            If s = 0 Then Exit Do
            If k = 0 Then
                t = Rhino.Min(tempT)
            Else
                t = Rhino.Max(tempT)
            End If
            r = r + 1
            ReDim Preserve pt(r)
            pt(r) = Rhino.EvaluateCurve(curve, t)
            s = 0
        Loop
        pts(k) = pt
    Next
    evalCrvByDist = pts
End Function
Function reparameterize(strObjectID)
    If Rhino.IsCurve(strObjectID) = True Then
        Call rhino.SelectObject(strObjectID)
        Call rhino.Command("reparameterize 0 1", False)
        Call rhino.UnselectAllObjects()
    End If
    If Rhino.IsSurface(strObjectID) = True Then
        Call rhino.SelectObject(strObjectID)
        Call rhino.Command("reparameterize 0 1 0 1", False)
        Call rhino.UnselectAllObjects()
    End If     
End Function
Ā 


0 views

Recent Posts

See All
bottom of page