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>
0 responses so far ↓
There are no comments yet...Kick things off by filling out the form below.