Conic Polyline

Option Explicit

Sub DrawSmoothPolyline()
 Dim Original, NewCurve
 Dim TipWeight, TipPoints
 Dim index, i
 Dim Odd, NB1, NB2

 Dim arrStrings(3)
 Dim arrWeight(), arrPoints(), arrKnots()

 NewCurve = "Empty"
 TipWeight = Rhino.GetSettings(Rhino.InstallFolder & "Gelfling.ini",

"ConicPolyline", "TipWeight")
 If VarType(TipWeight) = vbNull Then
  TipWeight = 100
 Else
  TipWeight = CLng(TipWeight)
 End IF

 Original = Rhino.GetObject("Pick a polyline to convert", 4, True)
 If VarType(Original) = vbNull Then Exit Sub
 If Not Rhino.IsPolyline(Original) Then Rhino.Print "Only polylines can be

converted..." : Exit Sub
 
 TipPoints = Rhino.PolylineVertices(Original)
 If Not IsArray(TipPoints) Then Rhino.Print "Invalid polyline object...": Exit

Sub

 If Rhino.IsCurveClosed(Original) Then
  ReDim arrPoints(2 * UBound(TipPoints) + 2)
  ReDim arrWeight(UBound(arrPoints))
  ReDim arrKnots(UBound(arrPoints) + 2)
  
  i = -1 : Odd = 0
  Rhino.Prompt "Building control point data... please wait"
  For index = 0 To UBound(arrPoints) - 2
   If Odd = 0 Then
    i = i+1
    arrPoints(index) = TipPoints(i)
    Odd = 1
   Else
    NB1 = TipPoints(i)
    NB2 = TipPoints(i+1)
    arrPoints(index) = Array((NB1(0)+NB2(0))/2 ,

(NB1(1)+NB2(1))/2 , (NB1(2)+NB2(2))/2)
    Odd = 0
   End If
  Next
  arrPoints(UBound(arrPoints) - 1) = arrPoints(1)
  arrPoints(UBound(arrPoints) - 0) = arrPoints(2)
 
  For index = 0 To UBound(arrKnots)
   arrKnots(index) = index
  Next
 Else
  ReDim arrPoints(2 * UBound(TipPoints))
  ReDim arrWeight(UBound(arrPoints))
  ReDim arrKnots(UBound(arrPoints) + 2)
  
  i = -1 : Odd = 0
  Rhino.Prompt "Building control point data... please wait"
  For index = 0 To UBound(arrPoints)
   If Odd = 0 Then
    i = i+1
    arrPoints(index) = TipPoints(i)
    Odd = 1
   Else
    NB1 = TipPoints(i)
    NB2 = TipPoints(i+1)
    arrPoints(index) = Array((NB1(0)+NB2(0))/2 ,

(NB1(1)+NB2(1))/2 , (NB1(2)+NB2(2))/2)
    Odd = 0
   End If
  Next
 
  arrKnots(0) = 0
  arrKnots(1) = 0
  arrKnots(2) = 0
  For index = 3 To UBound(arrKnots)-3
   arrKnots(index) = index-2
  Next
  arrKnots(UBound(arrKnots)-2) = arrKnots(UBound(arrKnots)-3)+1
  arrKnots(UBound(arrKnots)-1) = arrKnots(UBound(arrKnots)-3)+1
  arrKnots(UBound(arrKnots)-0) = arrKnots(UBound(arrKnots)-3)+1
 End If
 
 arrStrings(1) = "Restore_input"
 Rhino.UnselectObject Original
 Rhino.HideObject Original
 
 Do
  Odd = 0
  For index = 0 To UBound(arrWeight)
   If Odd = 0 Then
    arrWeight(index) = 1
    Odd = 1
   Else
    arrWeight(index) = TipWeight/100
    Odd = 0
   End If
  Next
  NewCurve = Rhino.AddNurbsCurve(arrPoints, arrKnots, 3, arrWeight)
  If VarType(NewCurve) = vbNull Then
   Rhino.Print "Error in NURBS data ... aborting"
   Rhino.ShowObject Original
   Exit Sub
  End If
  ´Rhino.SelectObject CStr(NewCurve)

  arrStrings(0) = "Weight_" & TipWeight
  arrStrings(2) = "Finish"
  arrStrings(3) = "Cancel"
 
  Odd = Rhino.GetString("Conic polyline", , arrStrings)
  If VarType(Odd) = vbNull Then Odd = "CANCEL"

  If IsNumeric(Odd) Then
   Odd = Abs(CInt(Odd))
   If Odd < 1 Then Odd = 1
   If Odd > 500 Then Odd = 500
   TipWeight = Odd
  Else
   Select Case UCase(Left(Odd, 1))
   Case "W"
    TipWeight = Rhino.GetInteger("Specify a corner weight

value%...", TipWeight, 1, 500)
    If VarType(TipWeight) = vbNull Then TipWeight = 100
   Case "D"
    Rhino.HideObject Original
    arrStrings(1) = "Restore_input"
   Case "R"
    Rhino.ShowObject Original
    arrStrings(1) = "Delete_input"
   Case "F"
    Exit Do
   Case "C"
    Rhino.DeleteObject NewCurve
    Rhino.ShowObject Original
    Exit Sub
   Case Else
    Exit Do
   End Select
  End If

  If NewCurve <> "Empty" Then Rhino.DeleteObject(NewCurve)
  If arrStrings(1) = "Restore_input" Then
   Rhino.ShowObject Original
   Rhino.DeleteObject Original
  End If

  Rhino.SaveSettings Rhino.InstallFolder & "Gelfling.ini",

"ConicPolyline", "TipWeight", TipWeight
 Loop

End Sub
DrawSmoothPolyline

Ekleyen: Mad_Max