Multi Pipe

Seçilen Curve aksında belli bir et kalınlığına sahip boru ekstrüzyon scripti..

Option Explicit

Sub MultiPipe()
Dim AllCurves
Dim blnCap, blnThick
Dim Radius1, Radius2
Dim dblWall
Dim blnPreview
Dim arrPreviewCircles
Dim strResult, arrOptions()

AllCurves = Rhino.GetObjects("Select curves to pipe...", 4, vbFalse, vbTrue, vbTrue)
If IsNull(AllCurves) Then Exit Sub

blnCap = Rhino.GetSettings(Rhino.InstallFolder & "Gelfling.ini", "MultiPipe", "Caps")
If IsNull(blnCap) Then blnCap = vbTrue Else blnCap = CBool(blnCap)
blnThick = Rhino.GetSettings(Rhino.InstallFolder & "Gelfling.ini", "MultiPipe", "Thick")
If IsNull(blnThick) Then blnThick = vbTrue Else blnThick = CBool(blnThick)
blnPreview = Rhino.GetSettings(Rhino.InstallFolder & "Gelfling.ini", "MultiPipe", "Preview")
If IsNull(blnPreview) Then blnPreview = vbTrue Else blnPreview = CBool(blnPreview)
Radius1 = Rhino.GetSettings(Rhino.InstallFolder & "Gelfling.ini", "MultiPipe", "Radius1")
If IsNull(Radius1) Then Radius1 = 1 Else Radius1 = CDbl(Radius1)
Radius2 = Rhino.GetSettings(Rhino.InstallFolder & "Gelfling.ini", "MultiPipe", "Radius2")
If IsNull(Radius2) Then Radius2 = 1 Else Radius2 = CDbl(Radius2)
dblWall = Rhino.GetSettings(Rhino.InstallFolder & "Gelfling.ini", "MultiPipe", "WallThickness")
If IsNull(dblWall) Then dblWall = 0.25 Else dblWall = CDbl(dblWall)

arrPreviewCircles = Array("Nothing")
Do
  If blnPreview Then
   Rhino.EnableRedraw vbFalse
   Rhino.DeleteObjects arrPreviewCircles
   arrPreviewCircles = DrawPreview(AllCurves, blnThick, Radius1, Radius2, Abs(Radius1+dblWall), Abs(Radius2+dblWall))
   If IsNull(arrPreviewCircles) Then arrPreviewCircles = Array("Nothing")
   Rhino.EnableRedraw vbTrue
  End If

  If blnThick Then
   ReDim arrOptions(7)
   arrOptions(0) = "Caps_" & Boolean2String(blnCap)
   arrOptions(1) = "Thick_" & Boolean2String(blnThick)
   arrOptions(2) = "Preview_" & Boolean2String(blnPreview)
   arrOptions(3) = "Radius_Start"
   arrOptions(4) = "Radius_End"
   arrOptions(5) = "Wall_Thickness"
   arrOptions(6) = "Accept"
   arrOptions(7) = "Quit"
  Else
   ReDim arrOptions(6)
   arrOptions(0) = "Caps_" & Boolean2String(blnCap)
   arrOptions(1) = "Thick_" & Boolean2String(blnThick)
   arrOptions(2) = "Preview_" & Boolean2String(blnPreview)
   arrOptions(3) = "Radius_Start"
   arrOptions(4) = "Radius_End"
   arrOptions(5) = "Accept"
   arrOptions(6) = "Quit"
  End If
  strResult = Rhino.GetString("Multipipe options...", "Accept", arrOptions)
  If IsNull(strResult) Then strResult = "Quit"
  If IsNumeric(strResult) Then
   strResult = CDbl(strResult)
   If strResult = 0 Then
    blnThick = vbFalse
    blnCap = vbFalse
   ElseIf strResult > 0 Then
    Radius1 = strResult
    Radius2 = strResult
   Else
    dblWall = strResult
   End If
  Else
   Select Case UCase(Left(strResult,1))
   Case "C"
    blnCap = Not blnCap
   Case "T"
    blnThick = Not blnThick
   Case "P"
    blnPreview = Not blnPreview
    If Not blnPreview Then Rhino.DeleteObjects arrPreviewCircles
   Case "R"
    Select Case UCase(strResult)
    Case "RADIUS_START"
     strResult = Rhino.GetReal("Specify a new starting radius", Radius1, Rhino.UnitAbsoluteTolerance)
     If Not IsNull(strResult) Then Radius1 = strResult
    Case "RADIUS_END"
     strResult = Rhino.GetReal("Specify a new ending radius", Radius2, Rhino.UnitAbsoluteTolerance)
     If Not IsNull(strResult) Then Radius2 = strResult
    End Select
   Case "W"
    strResult = Rhino.GetReal("Specify a new wall-shell thickness (negative values offset towards the center of the pipe)", dblWall)
    If Not IsNull(strResult) Then
     If strResult = 0 Then
      blnThick = vbFalse
      blnCap = vbFalse
     Else
      dblWall = strResult
     End If
    End If
   Case "A"
    Rhino.EnableRedraw vbFalse
    Rhino.DeleteObjects arrPreviewCircles
    AddPipes AllCurves, blnThick, blnCap, Radius1, Radius2, Abs(Radius1+dblWall), Abs(Radius2+dblWall)
    Rhino.SelectObjects AllCurves
    Rhino.EnableRedraw vbTrue
    Exit Do
   Case "Q"
    Rhino.DeleteObjects arrPreviewCircles
    Exit Sub
   End Select
  End If
Loop

Rhino.SaveSettings Rhino.InstallFolder & "Gelfling.ini", "MultiPipe", "Caps", CStr(blnCap)
Rhino.SaveSettings Rhino.InstallFolder & "Gelfling.ini", "MultiPipe", "Thick", CStr(blnThick)
Rhino.SaveSettings Rhino.InstallFolder & "Gelfling.ini", "MultiPipe", "Preview", CStr(blnPreview)
Rhino.SaveSettings Rhino.InstallFolder & "Gelfling.ini", "MultiPipe", "Radius1", CStr(Radius1)
Rhino.SaveSettings Rhino.InstallFolder & "Gelfling.ini", "MultiPipe", "Radius2", CStr(Radius2)
Rhino.SaveSettings Rhino.InstallFolder & "Gelfling.ini", "MultiPipe", "WallThickness", CStr(dblWall)
Rhino.Print "Pipes added..."
End Sub
MultiPipe

Function AddPipes(AllCurves, blnThick, blnCap, Radius1, Radius2, Radius3, Radius4)
AddPipes = Null
Dim i

For i = 0 To UBound(AllCurves)
  Rhino.UnselectAllObjects
  Rhino.SelectObject AllCurves(i)
  If Rhino.IsCurveClosed(AllCurves(i)) Then
   Rhino.Command "-_Pipe " & Radius1, vbFalse
   If blnThick Then Rhino.Command "-_Pipe " & Radius3, vbFalse
  Else
   If blnThick Then
    Rhino.Command "-_Pipe _Cap=" & Boolean2String(blnCap) & " _Thick=Yes " & _
        Radius1 & " " & Radius3 & " " & Radius2 & " " & Radius4, vbFalse
   Else
    Rhino.Command "-_Pipe _Cap=" & Boolean2String(blnCap) & " _Thick=No " & _
        Radius1 & " " & Radius2, vbFalse
   End If
  End If
Next
AddPipes = vbTrue
End Function

Function DrawPreview(AllCurves, blnThick, Radius1, Radius2, Radius3, Radius4)
DrawPreview = Null
Dim crvDomain
Dim vecT, idCircle
Dim arrN(), i, c

c = 0
For i = 0 To UBound(AllCurves)
  crvDomain = Rhino.CurveDomain(AllCurves(i))
  vecT = Rhino.CurveTangent(AllCurves(i), crvDomain(0))
  If Not IsNull(vecT) Then
   idCircle = Rhino.AddCircle(vecT(0), Radius1, vecT(1))
   If Not IsNull(idCircle) Then
    Rhino.ObjectColor idCircle, 0
    ReDim Preserve arrN(c)
    arrN(c) = idCircle
    c = c+1
   End If

   If blnThick Then
    idCircle = Rhino.AddCircle(vecT(0), Radius3, vecT(1))
    If Not IsNull(idCircle) Then
     Rhino.ObjectColor idCircle, vbWhite
     ReDim Preserve arrN(c)
     arrN(c) = idCircle
     c = c+1
    End If
   End If
  End If

  vecT = Rhino.CurveTangent(AllCurves(i), crvDomain(1))
  If Not IsNull(vecT) And Not Rhino.IsCurveClosed(AllCurves(i)) Then
   idCircle = Rhino.AddCircle(vecT(0), Radius2, vecT(1))
   If Not IsNull(idCircle) Then
    Rhino.ObjectColor idCircle, 0
    ReDim Preserve arrN(c)
    arrN(c) = idCircle
    c = c+1
   End If

   If blnThick Then
    idCircle = Rhino.AddCircle(vecT(0), Radius4, vecT(1))
    If Not IsNull(idCircle) Then
     Rhino.ObjectColor idCircle, vbWhite
     ReDim Preserve arrN(c)
     arrN(c) = idCircle
     c = c+1
    End If
   End If
  End If
Next
If c = 0 Then Exit Function
DrawPreview = arrN
End Function