Diggin’ on hell’s door

Option Explicit
‘Script written by Ado

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)
 
 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 : 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 (“Curve: ” & j & “, (StrtPoint).” & vbCrLf & “Length: ” & Length,StrtPt,CInt(Length/75),”Verdana”)
  Dim txt2: txt2 = Rhino.AddText (“Curve: ” & j & “, (StrtPoint).” & vbCrLf & “Length: ” & Length,EndPt,CInt(Length/75),”Verdana”)
  
  ‘Change layers  
  Rhino.ObjectLayer hl,”annotations”
 Next
 Rhino.ObjectLayer arrPoly,”Polylines”
End Sub

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(128, 128, 128),True,False,”Script”
  Rhino.LayerLinetype “Polylines”, “Dashed”
 End If
End Function

<br>

<hr>

Digging and back overground!

Digging and back overground!

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s