Non-Linear Spiral

Bu 10 dökümanın tek bir başlık altında toplanması daha uygun olacaktır.

Ayrıca direkt olarak scriptle üretilen modelin ne kadar eğitici olabilileceği tartışılır. bu program hakkında bilgi sahibi değilim. Hepsinin bir başlık altında toplanması, açıklamalar yapılarak bir txt dökümanına link verilmesi gerektiğini düşünüyorum.

Option Explicit

Sub NonLinearSpiral()
 Dim arrAxis, idLast, idSpiral, idShiftAxis
 Dim spSpiral, epSpiral, intSpiral, vecSpiral, domSpiral
 Dim Radius, dblTurns, CCW, i
 Dim SampleDensity, Acceleration, accOld
 Dim strResult, arrOptions(2)

 arrAxis = Rhino.GetPoints(vbTrue,, "Start of axis", "End of axis", 2)
 If IsNull(arrAxis) Then Exit Sub
 If UBound(arrAxis) <> 1 Then Exit Sub
 
 idLast = Rhino.FirstObject
 Rhino.Command "-_Helix w" & Rhino.Pt2Str(arrAxis(0)) & " w" & Rhino.Pt2Str(arrAxis(1))
 If Rhino.LastCommandResult <> 0 Then Exit Sub
 idSpiral = Rhino.FirstObject
 If idSpiral = idLast Then Exit Sub
 spSpiral = Rhino.CurveStartPoint(idSpiral)
 epSpiral = Rhino.CurveEndPoint(idSpiral)
 domSpiral= Rhino.CurveDomain(idSpiral)
 vecSpiral= Rhino.CurveTangent(idSpiral, domSpiral(0))(1)
 Radius = Rhino.Distance(spSpiral, arrAxis(0))
 If Rhino.Distance(spSpiral, arrAxis(1)) < Radius Then Radius = Rhino.Distance(spSpiral, arrAxis(1))
 idShiftAxis = Rhino.AddLine(spSpiral, Array(spSpiral(0) + (arrAxis(1)(0)-arrAxis(0)(0)), _
            spSpiral(1) + (arrAxis(1)(1)-arrAxis(0)(1)), _
            spSpiral(2) + (arrAxis(1)(2)-arrAxis(0)(2))))
 intSpiral = Rhino.CurveCurveIntersection(idSpiral, idShiftAxis, Rhino.UnitAbsoluteTolerance*0.1)
 
 Rhino.DeleteObject idShiftAxis

 If IsNull(domSpiral) Or IsNull(vecSpiral) Or IsNull(intSpiral) Then Exit Sub
 If UBound(intSpiral) < 1 Then
  Rhino.Print "You need at least one full turn for the non-linear spiral curve..."
  Rhino.DeleteObject idSpiral
  Exit Sub
 End If
 
 dblTurns = UBound(intSpiral)
 If intSpiral(UBound(intSpiral), 5) <> domSpiral(1) Then
  dblTurns = dblTurns + (domSpiral(1)-intSpiral(UBound(intSpiral), 5)) / (intSpiral(1,5)-intSpiral(0,5))
 End If

 Acceleration = Rhino.GetSettings(Rhino.InstallFolder & "Gelfling.ini", "NLSpiral", "Acceleration")
 If IsNull(Acceleration) Then Acceleration = 2.5 Else Acceleration = CDbl(Acceleration)
 accOld = 1
 SampleDensity = 24

 For i = 0 To 15
  Rhino.EnableRedraw vbFalse
  Rhino.DeleteObject idSpiral
  accOld = accOld + (Acceleration-accOld)/1.5
  idSpiral = addNlSpiral(arrAxis, spSpiral, Radius, dblTurns, vbTrue, SampleDensity, accOld)
  Rhino.EnableRedraw vbTrue
 Next
 accOld = Acceleration

 Do
  Rhino.Prompt "Preview"
  Rhino.EnableRedraw vbFalse
  Rhino.DeleteObject idSpiral
  idSpiral = addNlSpiral(arrAxis, spSpiral, Radius, dblTurns, vbTrue, SampleDensity, Acceleration)
  Rhino.EnableRedraw vbTrue

  arrOptions(0) = "Deformation"
  arrOptions(1) = "Accept"
  arrOptions(2) = "Quit"
  strResult = Rhino.GetString("Deformation=" & Acceleration, "Accept", arrOptions)
  If IsNull(strResult) Then strResult = "Quit"
  If IsNumeric(strResult) Then
   strResult = CDbl(strResult)
   If strResult >= 0.01 And strResult <= 100 Then
    Acceleration = strResult
   End If
  Else
   Select Case UCase(Left(strResult,1))
   Case "D"
    strResult = Rhino.GetReal("Specify a new deformation for the helix", Acceleration, 0.01, 100)
    If Not IsNull(strResult) Then Acceleration = strResult
   Case "A"
    Exit Do
   Case "Q"
    Rhino.DeleteObject idSpiral
    Exit Sub
   End Select
  End If
 Loop
 
 Rhino.SaveSettings Rhino.InstallFolder & "Gelfling.ini", "NLSpiral", "Acceleration", CStr(Acceleration)
 Rhino.Print "Non-linear spiral added"
End Sub
NonLinearSpiral

Function AddNLSpiral(arrAxis, arrStart, dblRadius, dblTurns, CCW, SampleDensity, Power)
 AddNLSpiral = Null

 Dim piT, piS
 Dim adjDirection
 Dim x,y,z
 Dim t,i
 Dim arrPt()
 Dim idCurve

 piT = 8*Atn(1)*dblTurns
 piS = 4*Atn(1)/SampleDensity

 If CCW Then adjDirection = 1 Else adjDirection = -1

 i = 0
 For t = 0 To piT + (piS) Step 2*piS
  x = dblRadius * Cos(t)
  y = dblRadius * Sin(t) * adjDirection
  z = OffsetFactor(t/(piT), Power) * Rhino.Distance(arrAxis(0),arrAxis(1))

  ReDim Preserve arrPt(i)
  arrPt(i) = Array(x,y,z)
  i = i+1
 Next

 idCurve = Rhino.AddInterpCurve(arrPt)
 Rhino.OrientObject idCurve, _
      Array(Array(0,0,0), Array(0,0,1), Array(1,0,0)), _
      Array(arrAxis(0), arrAxis(1), arrStart)
 AddNLSpiral = idCurve
End Function

Function OffsetFactor(t, dblPower)
 OffsetFactor = t
 t = Round(t*2,7)
 If t = 0 Or t = 1 Or t = 2 Then Exit Function

 If t < 1 Then
  OffsetFactor = t^dblPower
 Else
  OffsetFactor = 1-(1-(t-1))^dblPower+1
 End If
 OffsetFactor = OffsetFactor/2
End Function

Ekleyen: Mad_Max