Option Explicit
'Script written by Luis Quinones
'www.luisquinonesdesign.com
'www.computationalmatter.com
'Small part of code uses Roland Snooks edit grip pts.rs code.
'Script version Wednesday, May 18, 2011 12:51:12 PM
Call Main()
Sub Main()
'Dim LayerChoose : LayerChoose = Rhino.GetLayer
Dim strMesh
Dim AttThresh : AttThresh = Rhino.GetReal("Pull_attraction threshold", 60)
Dim Snap : Snap = Rhino.GetReal("Pull_attraction threshold to directly snap to surface", 25)
Dim VecRatio : VecRatio = Rhino.GetReal("ratio of distance to move", 0.5)
'Call Rhino.Print(Ubound(strMesh))
'Dim strMesh : strMesh = Rhino.GetObjects("MESHES",32)
Dim z
Dim i
Dim color
Dim newPts()
Dim newPts2()
'Rhino.EnableRedraw False
Dim q
For q = 0 To 20
Dim gens : gens = 1
Dim attraction
If q = 0 Then
attraction = 0
color = RGB(255,0,0)
End If
If q = 1 Then
attraction = 1
color = RGB(255,83,83)
End If
If q = 2 Then
attraction = 1
color = RGB(205,208,208)
End If
If q = 3 Then
attraction = 1
color = RGB(180,180,180)
End If
If q = 4 Then
attraction = 2
color = RGB(17,128,196)
End If
If q = 5 Then
attraction = 2
color = RGB(255,178,0)
End If
If q = 6 Then
attraction = 4
color = RGB(0,255,18)
End If
If q = 7 Then
attraction = 4
color = RGB(0,255,209)
End If
If q = 8 Then
attraction = 6
color = RGB(0,146,255)
End If
If q = 9 Then
attraction = 7
color = RGB(233,0,255)
End If
If q = 10 Then
attraction = 7
color = RGB(242,105,255)
End If
If q = 11 Then
attraction = 8
color = RGB(188,105,255)
End If
If q = 12 Then
attraction = 8
color = RGB(120,105,255)
End If
If q = 13 Then
attraction = 10
color = RGB(0,255,255)
End If
If q = 14 Then
attraction = 8
color = RGB(72,239,45)
End If
If q = 15 Then
attraction = 8
color = RGB(200,239,45)
End If
If q = 16 Then
attraction = 6
color = RGB(239,192,45)
End If
If q = 17 Then
attraction = 6
color = RGB(239,90,45)
End If
If q = 18 Then
attraction = 4
color = RGB(239,45,63)
End If
If q = 19 Then
attraction = 2
color = RGB(223,42,255)
End If
If q = 20 Then
attraction = 0
color = RGB(114,42,255)
End If
Dim strNewLayer : strNewLayer = Rhino.AddLayer("Plines" & q,color)
If q > 0 Then
Call Rhino.LayerColor("Plines"& q-1,RGB(83,83,83))
End If
strMesh = Rhino.ObjectsByLayer("A" & q)
For z = 0 To Ubound(strMesh)
Rhino.EnableRedraw False
'Call Rhino.Print ("ON_Mesh_" & z)
Dim strLayer : strLayer = Rhino.AddLayer("Frame" & z,RGB(255,255,255))
Dim arrFaces : arrFaces = Rhino.MeshFaces(strMesh(z))
'Call Rhino.Print("Mesh_" & z & "_" & Ubound(arrFaces))
ReDim arrFace(3)
Do While i < Ubound(arrFaces)
arrFace(0) = arrFaces(i)
arrFace(1) = arrFaces(i+1)
arrFace(2) = arrFaces(i+2)
arrFace(3) = arrFaces(i+3)
Dim newLine : newLine = Rhino.AddLine(arrFace(0),arrFace(1))
Call Rhino.ObjectLayer(newLine,strLayer)
i = i + 4
Loop
i = 0
Dim crvs : crvs = Rhino.ObjectsByLayer("Frame" & z,True)
If isNull (crvs) Then
Rhino.Print "Opps"
End If
'Rhino.Command "SelOpenCrv"
Rhino.Command "Join"
Rhino.UnselectAllObjects
Dim crv
Dim count
count = 0
Dim arrCrvstest : arrCrvstest = Rhino.ObjectsByLayer("Frame" & z)
Dim y
Dim testCrv
Dim count2
count2 = 0
For Each testCrv In arrCrvstest
Dim meshtest : meshtest = Rhino.MeshPolyline(arrCrvstest(count2))
Dim areatest : areatest = Rhino.MeshArea(meshtest)
If areatest(1) = 0 Then
Call Rhino.Print("ONE FAILED")
Call Rhino.DeleteObject(arrCrvstest(count2))
End If
Call Rhino.DeleteObject(meshtest)
count2 = count2 + 1
Next
Rhino.UnselectAllObjects
Dim arrCrvs : arrCrvs = Rhino.ObjectsByLayer("Frame" & z)
For Each crv In arrCrvs
Dim mesh : mesh = Rhino.MeshPolyline(arrCrvs(count))
ReDim Preserve newPts(count)
ReDim Preserve newPts2(count)
Dim centroid : centroid = Rhino.MeshAreaCentroid(mesh)
Call Rhino.LayerVisible("Frame" & z,False)
Rhino.EnableRedraw True
'If q = 0 And z < 2 Then
' Call Rhino.RotateView("d",0,0.1)
'End If
newPts(count) = Rhino.AddPoint(centroid)
newPts2(count) = Rhino.AddPoint(array(centroid(0)*-1,centroid(1),centroid(2)))
count = count + 1
Rhino.DeleteObject(mesh)
Next
Dim k
Dim ptloc
Dim ptloc2
ptloc = newPts
ptloc2 = newPts2
For k = 0 To Ubound(newPts)
ptloc(k) = Rhino.PointCoordinates(newPts(k))
ptloc2(k) = Rhino.PointCoordinates(newPts2(k))
Next
Dim checker
checker = Ubound(strMesh)
Rhino.Print checker
If q = 1 And z = checker - 2 Then
Dim f
For f = 0 To 600
Call Rhino.RotateView("e",0,.5)
Next
End If
If q = 4 And z = checker - 3 Then
For f = 0 To 120
Call Rhino.RotateView("e",0,.5)
Next
End If
If q = 10 And z = checker - 1 Then
Dim reduce
Dim x
reduce = q
For x = 0 To reduce
If x >= 1 Then
Call Rhino.LayerVisible("Plines"& x-1,False)
End If
Next
For f = 0 To 900
Call Rhino.RotateView("e",0,.5)
Next
End If
If q = 14 And z = checker - 3 Then
Dim reduce2
reduce2 = q
For x = 0 To reduce2
If x >= 1 Then
Call Rhino.LayerVisible("Plines"& x-1,True)
End If
Next
For f = 0 To 540
Call Rhino.RotateView("e",0,.5)
Next
End If
Call Rhino.DeleteObjects(newPts)
Call Rhino.DeleteObjects(newPts2)
Dim pLines : pLines = Rhino.AddPolyline(ptloc)
Dim pLines2 : pLines2 = Rhino.AddPolyline(ptloc2)
If Not IsNull(pLines) Then
Rhino.RebuildCurve pLines, 2, 40
Rhino.RebuildCurve pLines2, 2, 40
End If
Call Rhino.ObjectLayer(pLines,strNewLayer)
Call Rhino.ObjectLayer(pLines2,strNewLayer)
Erase newPts
Erase ptloc
Erase newPts2
Erase ptloc2
Rhino.LayerVisible strLayer,False
Rhino.PurgeLayer strLayer
Next
Dim meshPull : meshPull = Rhino.ObjectsByLayer("M"& q & "_OffSetMesh")
Rhino.Print "AttractionThreshold" & " =" & attraction
Call Bundle (strNewLayer,gens,attraction,meshPull,AttThresh,Snap,VecRatio)
Next
Dim h
Dim testcount : testcount = 12
For h = 0 To 20
If h = 0 Then
Call Rhino.LayerColor("Plines" & "20", RGB(255,0,0))
End If
If h = 1 Then
Call Rhino.LayerColor("Plines" & "19", RGB(255,83,83))
End If
If h = 2 Then
Call Rhino.LayerColor("Plines" & "18", RGB(205,208,208))
End If
If h = 3 Then
Call Rhino.LayerColor("Plines" & "17", RGB(180,180,180))
End If
If h = 4 Then
Call Rhino.LayerColor("Plines" & "16", RGB(17,128,196))
End If
If h = 5 Then
Call Rhino.LayerColor("Plines" & "15", RGB(255,178,0))
End If
If h = 6 Then
Call Rhino.LayerColor("Plines" & "14", RGB(0,255,18))
End If
If h = 7 Then
Call Rhino.LayerColor("Plines" & "13", RGB(0,255,209))
End If
If h = 8 Then
Call Rhino.LayerColor("Plines" & "12", RGB(0,146,255))
End If
If h = 9 Then
Call Rhino.LayerColor("Plines" & "11", RGB(233,0,255))
End If
If h = 10 Then
Call Rhino.LayerColor("Plines" & "10", RGB(242,105,255))
End If
If h = 11 Then
Call Rhino.LayerColor("Plines" & "9", RGB(188,105,255))
End If
If h = 12 Then
Call Rhino.LayerColor("Plines" & "8", RGB(120,105,255))
End If
If h = 13 Then
Call Rhino.LayerColor("Plines" & "7", RGB(0,255,255))
End If
If h = 14 Then
Call Rhino.LayerColor("Plines" & "6", RGB(72,239,45))
End If
If h = 15 Then
Call Rhino.LayerColor("Plines" & "5", RGB(200,239,45))
End If
If h = 16 Then
Call Rhino.LayerColor("Plines" & "4", RGB(239,192,45))
End If
If h = 17 Then
Call Rhino.LayerColor("Plines" & "3", RGB(239,90,45))
End If
If h = 18 Then
Call Rhino.LayerColor("Plines" & "2", RGB(239,45,63))
End If
If h = 19 Then
Call Rhino.LayerColor("Plines" & "1", RGB(223,42,255))
End If
If h = 20 Then
Call Rhino.LayerColor("Plines" & "0", RGB(114,42,255))
End If
testcount = testcount - 1
Next
'Rhino.EnableRedraw True
'Rhino.LayerVisible LayerChoose,False
'Rhino.LayerVisible "Meshes",False
End Sub
Function Bundle(layer,gens,attraction,mesh,AttThresh,Snap,VecRatio)
Dim crvArr, steps, threshold, i, j, k, gripCount, dist, closestDist, closestVector, ratio
Dim crvPt, h, newPos, gripPos, count, crvParam
' input
crvArr = rhino.ObjectsByLayer(layer)
steps = gens
threshold = attraction
'ratio = rhino.GetReal("move ration", 0.5)
'Rhino.EnableRedraw False
' loop through steps
For h = 0 To steps
' loop through all the crvs
For i = 0 To UBound(crvArr)
' how many control points on the crv
Rhino.EnableObjectGrips crvArr(i), True
gripCount = Rhino.ObjectGripCount(crvArr(i))
' loop through each of the points on the crv
For j = 0 To gripCount-1
' get location of the grip
gripPos = Rhino.ObjectGripLocation(crvArr(i), j)
count = 0
' loop through all the curves to find the closest one
For k = 0 To UBound(crvArr)
' get the position of the points
crvParam = Rhino.CurveClosestPoint(crvArr(k), gripPos)
crvPt = Rhino.EvaluateCurve(crvArr(k), crvParam)
dist = Rhino.Distance(crvPt, gripPos)
If dist < threshold And Not i=k Then
If count = 0 Then
closestDist = dist
closestVector = Rhino.VectorCreate(crvPt, gripPos)
count = count + 1
Else
If dist < closestDist Then
closestDist = dist
closestVector = Rhino.VectorCreate(crvPt, gripPos)
count = count + 1
End If
End If
End If
Next 'k
If count = 0 Then
closestVector = Array(0,0,0)
End If
newPos = Rhino.VectorAdd(gripPos, closestVector)
Rhino.ObjectGripLocation crvArr(i), j, newPos
Next' j
Rhino.EnableObjectGrips crvArr(i), False
If Not IsNull(crvArr(i)) Then
Dim reb : reb = Rhino.RebuildCurve(crvArr(i), 2, 40)
If reb = True Then
Rhino.Print "Curve" & i & ".Has.Been.Rebuilt.@.2,40"
Else
Rhino.Print "DidntRebuiltIt"
End If
End If
Next ' i
Next ' h
'Rhino.EnableRedraw True
Call PullIt(crvArr,mesh,AttThresh,Snap,VecRatio)
End Function
Function PullIt(crvArr2,srfArr2,threshold2,snapThreshold2,ratio2)
Dim srfArr, crvArr, threshold, ratio, i, j, k, gripCount, gripPos, count, srfParam, srfPt, arrSrfPts()
Dim closeSrfInd, dist, vec, newPos, snapThreshold, meshPt
' input
srfArr = srfArr2
crvArr = crvArr2
threshold = threshold2
snapThreshold = snapThreshold2
ratio = ratio2
' loop through all crvs
For i = 0 To UBound(crvArr)
Rhino.EnableRedraw False
Rhino.EnableObjectGrips crvArr(i), True
' get grip count
gripCount = Rhino.ObjectGripCount(crvArr(i))
' loop through all pts
For j = 0 To gripCount-1
' get the location of the current grip
gripPos = Rhino.ObjectGripLocation(crvArr(i), j)
' k loop - crvs
count = 0
For k = 0 To UBound(srfArr)
' get the closest point on a srf
If IsMesh(srfArr(k))Then
meshPt = Rhino.MeshClosestPoint(srfArr(k), gripPos)
srfPt = meshPt(0)
Else
srfUV = Rhino.SurfaceClosestPoint(srfArr(k), gripPos)
srfPt = Rhino.EvaluateSurface(asrfArr(k), srfUV)
End If
ReDim Preserve arrSrfPts(count)
arrSrfPts(count) = srfPt
count = count + 1
Next ' k
' find the closest point
closeSrfInd = Rhino.PointArrayClosestPoint(arrSrfPts, gripPos)
srfPt = arrSrfPts(closeSrfInd)
' distance between point on curve and grip
dist = Rhino.Distance(gripPos, srfPt)
' check to see if in threshold
If dist < threshold Then
' move grip based on vector
vec = Rhino.VectorCreate(srfPt, gripPos)
If dist > snapThreshold Then
vec = Rhino.VectorScale(vec, ratio)
End If
newPos = Rhino.VectorAdd(vec, gripPos)
Rhino.ObjectGripLocation crvArr(i), j, newPos
End If
Next
Rhino.EnableRedraw True
Rhino.Print "ItsBeenPulled"
Rhino.EnableObjectGrips crvArr(i), False
Next
End Function
