Curved Box

Option Explicit

Sub InflatedBox()
 Dim recIn, dblValue, boxOut
 Dim strResult, arrOptions(3)

 recIn = Rhino.GetBox()
 If IsNull(recIn) Then Exit Sub

 strResult = Rhino.GetSettings(Rhino.InstallFolder & "Gelfling.ini", "InflatedBox", "Pressure")
 If IsNull(strResult) Then dblValue = 50 Else dblValue = CDbl(strResult)

 arrOptions(0) = "Pressure"
 arrOptions(1) = "Pick"
 arrOptions(2) = "Accept"
 arrOptions(3) = "Quit"
 boxOut = "Nothing"

 Do
  Rhino.EnableRedraw vbFalse
  Rhino.DeleteObject boxOut
  boxOut = AddInflatedBox(recIn, dblValue/100)
  Rhino.EnableRedraw vbTrue

  If IsNull(boxOut) Then Exit Sub
  strResult = Rhino.GetString("Inflated box [" & dblValue & "]", "Accept", arrOptions)
  If IsNull(strResult) Then strResult = "Quit"
  If IsNumeric(strResult) Then
   dblValue = CDbl(strResult)
  Else
   Select Case UCase(Left(strResult, 2))
   Case "PR"
    strResult = Rhino.GetReal("Specify a new pressure", dblValue)
    If Not IsNull(strResult) Then dblValue = strResult
   Case "PI"
    recIn = Rhino.GetBox()
    If IsNull(recIn) Then Exit Sub
   Case "AC"
    Exit Do
   Case "QU"
    Rhino.DeleteObject boxOut
    Exit Sub
   End Select
  End If
 Loop
 Rhino.SaveSettings Rhino.InstallFolder & "Gelfling.ini", "InflatedBox", "Pressure", CStr(dblValue)
End Sub
InflatedBox

Function AddInflatedBox(BBox, dblFactor)
 AddInflatedBox = Null
 Dim Sides(5), jBox
 Dim X, Y, Z
 
 X = Rhino.Distance(BBox(0),BBox(1))
 Y = Rhino.Distance(BBox(0),BBox(3))
 Z = Rhino.Distance(BBox(0),BBox(4))

 Sides(0) = CreateBlankFace(X, Y, dblFactor): If IsNull(Sides(0)) Then Exit Function
 Sides(1) = CreateBlankFace(X, Y, dblFactor): If IsNull(Sides(0)) Then Exit Function
 Sides(2) = CreateBlankFace(X, Z, dblFactor): If IsNull(Sides(0)) Then Exit Function
 Sides(3) = CreateBlankFace(X, Z, dblFactor): If IsNull(Sides(0)) Then Exit Function
 Sides(4) = CreateBlankFace(Y, Z, dblFactor): If IsNull(Sides(0)) Then Exit Function
 Sides(5) = CreateBlankFace(Y, Z, dblFactor): If IsNull(Sides(0)) Then Exit Function
 
 Rhino.OrientObject Sides(0), Array(Array(0,0,0), Array(X,0,0), Array(X,Y,0)), Array(BBox(4), BBox(5), BBox(6))
 Rhino.OrientObject Sides(1), Array(Array(0,0,0), Array(X,0,0), Array(X,Y,0)), Array(BBox(1), BBox(0), BBox(3))
 Rhino.OrientObject Sides(2), Array(Array(0,0,0), Array(X,0,0), Array(X,Y,0)), Array(BBox(0), BBox(1), BBox(5))
 Rhino.OrientObject Sides(3), Array(Array(0,0,0), Array(X,0,0), Array(X,Y,0)), Array(BBox(7), BBox(6), BBox(2))
 Rhino.OrientObject Sides(4), Array(Array(0,0,0), Array(X,0,0), Array(X,Y,0)), Array(BBox(1), BBox(2), BBox(6))
 Rhino.OrientObject Sides(5), Array(Array(0,0,0), Array(X,0,0), Array(X,Y,0)), Array(BBox(3), BBox(0), BBox(4))

 jBox = Rhino.JoinSurfaces(Array(Sides(0), Sides(2), Sides(3), Sides(4), Sides(5), Sides(1)), vbTrue)
 AddInflatedBox = jBox
End Function

Function CreateBlankFace(X, Y, dblFactor)
 CreateBlankFace = Null
 If dblFactor = 0 Then
  CreateBlankFace = Rhino.AddSrfPt(Array(Array(0,0,0), _
              Array(X,0,0), _
              Array(X,Y,0), _
              Array(0,Y,0)))
  Exit Function
 End If

 Dim Arcs(3), PtS, ptE, ptM
 Dim lastID, newID

 lastID = Rhino.FirstObject

 ptS = Array(0,0,0) : ptE = Array(X,0,0)
 ptM = Array(X/2, 0-dblFactor, dblFactor)
 Arcs(0) = Rhino.AddArc3Pt(ptS, ptE, ptM)
 ptS = Array(X,0,0) : ptE = Array(X,Y,0)
 ptM = Array(X+dblFactor, Y/2, dblFactor)
 Arcs(1) = Rhino.AddArc3Pt(ptS, ptE, ptM)
 ptS = Array(X,Y,0) : ptE = Array(0,Y,0)
 ptM = Array(X/2, Y+dblFactor, dblFactor)
 Arcs(2) = Rhino.AddArc3Pt(ptS, ptE, ptM)
 ptS = Array(0,Y,0) : ptE = Array(0,0,0)
 ptM = Array(0-dblFactor, Y/2, dblFactor)
 Arcs(3) = Rhino.AddArc3Pt(ptS, ptE, ptM)

 Rhino.UnselectAllObjects
 Rhino.SelectObjects Arcs
 Rhino.Command "-_EdgeSrf", vbFalse
 Rhino.DeleteObjects Arcs
 newID = Rhino.FirstObject
 If newID = lastID Then newID = Null
 CreateBlankFace = newID
End Function

Ekleyen: Mad_Max