(n)certainties – Columbia – Fall 2008

Option Explicit
‘Script written by Adolfo Nadal
‘Script Copyrighted by Archiologics

Call Main()
Sub Main()
 
 Dim inLayer
 inLayer = Rhino.GetString(“Introduce new Layers?”,”yes”,array(“yes”,”no”))
 If inLayer = “yes” Then
  Call AddLayers
 End If
 
 Dim arrPtSeed : arrPtSeed = Rhino.GetObject(“Base Point”,1)
 arrPtSeed = Rhino.PointCoordinates(arrPtSeed)
 If IsNull (arrPtSeed) Then Exit Sub
 
 Dim n : n = Rhino.GetInteger(“nr of points”, 10)
 
 ” SPEED:
 ’Dim bbox : bbox = Rhino.BoundingBox(strSrf)
 Dim min : min = -500 ‘Rhino.Distance(bbox(0),bbox(6))/8
 Dim max : max =  200 ‘Rhino.Distance(bbox(0),bbox(6))/4
 Dim Density : Density = 2
 
 Dim i, j, k, l, g : k = 1 : i = 0
 Dim arrPt, arrLines()
 Dim arrPtsCollect()
 
 ReDim Preserve arrPtsCollect(0)
 arrPtsCollect(0) = arrPtSeed
 
 ’————————————————————————————-
 ’————————————————————————————-
 Do Until k = n+1
  arrPt = array(arrPtSeed(0)+arbitraryValue(min, max),arrPtSeed(1) + arbitraryValue(min, max),arrPtSeed(2)- abs(1/2*arbitraryValue(min, max)))
  
  Dim arrPtNeighBor : arrPtneighbor = shortestPt(arrPtsCollect, arrPt)
  
  If arrPtneighbor(2) < min/2 Then
   arrPtneighbor(2)=0
  End If
  
  ReDim Preserve arrLines(k-1)
  arrLines(k-1) = Rhino.AddLine(arrPt, arrPtNeighBor)
 
  ReDim Preserve arrPtsCollect(k)
  arrPtsCollect(k) = arrPt
  k = k + 1
 Loop
 ’————————————————————————————-
 ’————————————————————————————-

 Dim arrPoly : arrPoly = Rhino.JoinCurves(arrLines,True)
 Rhino.Print “From ” & Ubound(arrLines)+1 & ” segments ” & Ubound(arrPoly)+1 & ” polylines were extracted. Segments erased”
 
 ’————————————————————————————-
 ’————————————————————————————-
 
 For j=0 To Ubound(arrPoly)-1

  Dim StrtPt, EndPt
  StrtPt = Rhino.CurveStartPoint(arrPoly(j))
  EndPt = Rhino.CurveEndPoint(arrPoly(j))
  
  Dim strtvl, endvl, endvllength
  ’sometimes complains it does not find a string!!!
  If StrtPt(2)<>0 Then
   strtvl = Rhino.AddLine (StrtPt,array(StrtPt(0),StrtPt(1),0))
  End If
  
  If EndPt(2)<>0 Then
   endvl = Rhino.AddLine (EndPt, array(EndPt(0),EndPt(1),0))
   endvllength= Rhino.CurveLength(endvl)
   Rhino.Print endvl
  End If
  
  If Not IsNull(strtvl) Then
   ReDim arrPolyfinal(j)
   ’—————————————————————
   ’arrPolyfinal is a temp array to store the result, since the method joinCurves returns an array… this way we can avoid having nested arrays.
   arrPolyfinal(j) = Rhino.JoinCurves(array(arrPoly(j),strtvl),True)
   arrPoly(j) = arrPolyfinal(j)(0)
   Rhino.Print “so far, index j is ” & j
   If endvllength > Rhino.UnitRelativeTolerance Then
    If Not IsNull(endvl) And IsCurve(arrPoly(j)) Or IsPolyCurve(arrPoly(j)) Or IsPolyline(arrPoly(j)) Then
     ReDim arrPolyfinal(j)
     arrPolyfinal(j) = Rhino.JoinCurves(array(arrPoly(j),endvl) ,True)
     arrPoly(j) = arrPolyfinal(j)(0)
    End If
   End If
  Else
   If Not IsNull(endvl) Then
    arrPolyfinal(j) = Rhino.JoinCurves(array(arrPoly(j),endvl) ,True)
    arrPoly(j) = arrPolyfinal(j)(0)
   End If
  End If
  
  Dim Length
  Length = Rhino.CurveLength(arrPoly(j))
  If Length < max/density Then
   Rhino.DeleteObject(arrPoly(j))
   j=j-1
  End If
  
  Dim hl
  ’Add a (horizontal) line between end and start points
  StrtPt = Rhino.CurveStartPoint(arrPoly(j))
  EndPt = Rhino.CurveEndPoint(arrPoly(j))
  hl = Rhino.AddInterpCurve (array(StrtPt,EndPt))
  
  ’Add annotation text
  Dim txt1: txt1 = Rhino.AddText (“Crv ” & j & vbCrLf & “l= ” & Length,StrtPt,15,”Verdana”)  
  ’Change layers  
  Rhino.ObjectLayer txt1,”text”
  ’Rhino.ObjectLayer txt2,”text”
  Rhino.ObjectLayer hl,”annotations”
  
 Next
 ’————————————————————————————-
 ’————————————————————————————-

 ’we make curves out of the polyline
 ’————————————————————————————-
 ’————————————————————————————-
 Dim arrPolytmp()
 For l=0 To Ubound(arrPoly)
  ReDim arrPolytmp(l)
  arrPolytmp(l) = Rhino.CurvePoints (arrPoly(l))
  For g=0 To Ubound(arrPolytmp(l))-1
   Dim txt2
   txt2 = Rhino.AddText (“Pt ” & l & “,” & g & vbCrLf & “Zcoord: ” & arrPolytmp(l)(g)(2), arrPolytmp(l)(g), 5,”verdana”)
   Rhino.ObjectLayer txt2,”text”
   Call Rhino.ObjectColor(txt2,ParameterColor(Abs(arrPolytmp(l)(g)(2)/(min/density))))
  Next
  arrPoly(l)= Rhino.AddInterpCurve(arrPolytmp(l),3)
 Next
 ’————————————————————————————-
 ’————————————————————————————-
 
 Rhino.ObjectLayer arrPoly,”Polylines”
 Dim inHelix, npt
 inHelix = Rhino.GetString(“Run submachines?”,”yes”,array(“yes”,”no”))
 If inHelix = “yes” Then
  Dim counter, nhelix
  nhelix = Rhino.GetInteger(“nr of machines per line”,3,,4)
  npt = Rhino.GetInteger(“nr of points”,20,20)
  For counter=0 To Ubound (arrPoly)
   ’Rhino.SelectObject arrPoly(counter)
   Call HelixC (arrPoly(counter), StrtPt,nhelix,npt,.2,.2,10,20, Length/75)
   Rhino.CurrentLayer(“Default”)
   Rhino.UnselectAllObjects
  Next
 End If 
End Sub

Function ParameterColor(dblParam)
 Dim RedComponent : RedComponent = 255 * dblParam
 If (RedComponent<0) Then RedComponent = 0
 If (RedComponent>255) Then RedComponent = 255
 
 ParameterColor = RGB(RedComponent, 0, 255 – RedComponent)
 
End Function

Function shortestPt(arrPtsCollection, arrPtTest)
 Dim i
 Dim dblDistMin : dblDistMin = 100000000
 For i = 0 To UBound(arrPtsCollection)
  Dim dblDist : dblDist = rhino.Distance(arrPtTest, arrPtsCollection(i))
  If dbldist <> 0 Then
   If dblDist < dblDistMin Then
    dblDistMin = dblDist
    shortestPt = arrPtsCollection(i)
   End If
  End If
 Next
End Function

Function arbitraryValue(min, max)
 Randomize
 arbitraryValue = Int((max – min + 1) * Rnd + min)
End Function

Function AddLayers
 If Not IsLayer(“Script”) Then
  Rhino.AddLayer “Script”,RGB(0, 0, 0),True,False
 End If
 
 If Not IsLayer(“Polylines”) Then
  Rhino.AddLayer “Polylines”,RGB(128, 0, 128),True,False,”Script”
  Rhino.LayerLinetype “Polylines”, “Continuous”
 End If
 
 If Not IsLayer(“Points”) Then
  Rhino.AddLayer “Points”,RGB(0, 0, 0),True,False,”Script”
  Rhino.LayerLinetype “Polylines”, “Continuous”
 End If
 
 If Not IsLayer(“Annotations”) Then
  Rhino.AddLayer “Annotations”,RGB(128, 128, 128),True,False,”Script”
  Rhino.LayerLinetype “Polylines”, “Dots”
 End If
 
 If Not IsLayer(“Helix”) Then
  Rhino.AddLayer “Helix”,RGB(89, 50, 89),True,False,”Script”
  Rhino.LayerLinetype “Polylines”, “Dashed”
 End If
 
 If Not IsLayer(“Text”) Then
  Rhino.AddLayer “Text”,RGB(0, 0, 0),True,False,”Script”
  Rhino.LayerLinetype “Text”, “Continuous”
 End If
 
End Function

Function HelixC(strCrv,basePt,nhelix,npt, ByVal dblBendRadius,ByVal dblPerpRadius, Rotations, ByVal Diam,ByVal textsize)

 Rhino.CurrentLayer(“Helix”)
 Dim crvDomain
 
 Dim t, m
 Dim arrCrossSections(), CrossSectionPlane
 Dim crvCurvature, crvPoint, crvTangent, crvPerp, crvNormal
 Dim arrPt()
 Dim ptLine(), TgLine(), NrLine(), tmpVector
 ’Dim rotations : rotations= Rhino.GetInteger(“please enter nr of rotations”,10,1)
 Dim crvHelix
 Dim diameter : diameter = 6
 Dim Poly
 
 Dim k, i, rad
 For k = 0 To nhelix-1
  Dim tmprotation : tmprotation = 360/nhelix*(k+1)
  Dim factor : factor = 4
  ’rad = k/nsec*2*PI 
  
  crvDomain = Rhino.CurveDomain(strCrv)
  m = -1 
  For t = crvDomain(0) To crvDomain(1) + 1e-9 Step (crvDomain(1)-crvDomain(0))/npt
   m = m+1
   crvCurvature = Rhino.CurveCurvature(strCrv, t)
   If IsNull (crvCurvature) Then
    crvPoint = Rhino.EvaluateCurve(strCrv,t)
    crvTangent = Rhino.CurveTangent(strCrv,t)
    crvPerp = array(0,0,1)
    crvNormal = Rhino.VectorCrossProduct(crvTangent,crvPerp) 
   Else
    ’ CurveCurvature(0) returns point at the specified Perimeter on the curve
    crvPoint = crvCurvature(0)
    ’ CurveCurvature(1) returns the tangent vector
    crvTangent = crvCurvature(1)
    ’ CurveCurvature(4) returns the Curvature vector, meaning the one that goes from the pt on the curve to the center of curvature, therefore PERPENDICULAR
    ’crvPerp = Rhino.VectorUnitize(crvCurvature(4))
    crvPerp = crvCurvature(4)
    crvNormal = Rhino.VectorCrossProduct(crvTangent, crvPerp) 
   End If
   CrossSectionPlane = Rhino.PlaneFromFrame(crvPoint, crvPerp, crvNormal)
  
   ReDim Preserve arrPt(m)
   arrPt(m) = Rhino.VectorUnitize(crvPerp)
   arrPt(m) = Rhino.VectorScale(arrPt(m),100)
   arrPt(m) = Rhino.VectorRotate(arrPt(m),tmprotation,crvTangent)
   ’arrPt(m) = Rhino.AddPoint(Rhino.VectorRotate(Rhino.VectorScale(Rhino.VectorUnitize(crvPerp),dblPerpRadius),tmprotation,crvTangent))
  
   ’this adds the vector to put it to the needed position
   crvPerp= Rhino.VectorAdd(crvPoint,Rhino.VectorScale(crvPerp,factor))
   ’ReDim Preserve ptLine(m) : ptLine(m) = Rhino.AddLine ((crvPoint),crvPerp)
   ’Rhino.ObjectColor ptLine(m),vbred
   crvTangent = Rhino.VectorAdd(crvPoint,crvTangent)
   ’ReDim Preserve TgLine(m) : TgLine(m) = Rhino.AddLine (crvPoint,crvTangent)
   ’Rhino.ObjectColor TgLine(m),vbblue
   crvNormal = Rhino.VectorAdd(crvPoint,crvNormal)
   ’ReDim Preserve NrLine(m) : NrLine(m) = Rhino.AddLine (crvPoint,crvNormal)
   ’Rhino.ObjectColor NrLine(m),vbgreen
   ’here we take into account the initial angle (rad)
   crvHelix = Rhino.VectorRotate(crvPerp,tmprotation,crvTangent)
   ’crvHelix = Rhino.VectorRotate(crvPerp,(t*rad/(crvDomain(1)-crvDomain(0)))*Rotations,crvTangent)
   ReDim Preserve PolyPts(m)
   PolyPts(m) = Rhino.PointCoordinates(Rhino.AddPoint(crvHelix))
   ’Call Rhino.ObjectColor(crvHelix,ParameterColor(Abs(crvHelix(2)/(250))))
   Rhino.DeleteObjects(crvHelix)
  
   ’Rhino.Command “_Cplane _Previous”
   Rhino.UnselectAllObjects
  Next
  
  If m < 1 Then Exit Function
  
  Poly = Rhino.AddInterpCurve(PolyPts)
  Rhino.SelectObjects array(Poly)
  Rhino.Command “Pipe “&diameter/2&” “&diameter/2&” enter”
  Rhino.UnselectAllObjects
  Rhino.AddText “Settings 2: ” & vbCrLf & “1. Pipe radius= ” & (diameter/2) & vbCrLf & ” 2. Number of Spins: ” & (rotations) & vbCrLf & ” 3. Sample points: ” & (npt),array(basePt(0),basePt(1)-25, basePt(2)),textsize,”arial”
 Next
End Function