Surface Unrolling

'''
''' function for unrolling all surfaces
''' —-

Function unroll (arrObjects)

Dim arrUnrolledObj, arrEdge
Dim i, cnt:cnt = 0
Dim strTempPSrf, strText, strMacro, strPoint
Dim matPts(),pt
Dim arrSrfCent

ReDim arrUnrolledObj(UBOUND(arrObjects))

For i = 0 To UBOUND(arrObjects)

ReDim Preserve matPts(i)

If i<UBOUND(arrObjects)/2 Then

matPts(i) = array(i*500,1000,0)

Else

matPts(i) = array(cnt*500,2000,0)

cnt= cnt +1

End If

pt = Rhino.AddPoint(matPts(i))

Rhino.ObjectColor pt, RGB(255,0,255)

Next

For i = 0 To UBOUND(arrObjects)

arrSrfCent = Rhino.SurfaceAreaCentroid(arrObjects(i))(0)

strText = "a_" & i+1

Rhino.AddTextDot strText,arrSrfCent

Call Rhino.EnableRedraw(False)

Call Rhino.UnselectAllObjects

Call Rhino.SelectObject(arrObjects(i))

Rhino.Command "_Unrollsrf explode=no enter"

Call Rhino.UnselectAllObjects

arrUnrolledObj(i) = Rhino.FirstObject

Call Rhino.MoveObject(arrUnrolledObj(i),array(0,0,0), matPts(i))

arrSrfCent = Rhino.SurfaceAreaCentroid(arrUnrolledObj(i))(0)

strMacro = "-_TextObject Output=Curves "
strMacro = strMacro & "AllowOpenCurves=Yes " & "Height=10 "
strMacro = strMacro & "FontName=" & Chr(34) & "Machine Tool SanSerif" & Chr(34) & " "
strMacro = strMacro & strText & " "

strPoint = Rhino.Pt2Str(arrSrfCent)

strMacro = strMacro & strPoint
Call Rhino.Command (strMacro)

arrEdge = Rhino.DuplicateEdgeCurves(arrUnrolledObj(i))

Call Rhino.JoinCurves(arrEdge,True)

Call Rhino.DeleteObject(arrUnrolledObj(i))

Call Rhino.EnableRedraw(True)

Next

Call Rhino.EnableRedraw(False)

Call Rhino.EnableRedraw(True)

Rhino.ClearCommandHistory

End Function

Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-ShareAlike 3.0 License