Script I found

SA: You need to start with a 3D shape in your space

Option Explicit'Script written by

'Script copyrighted by
'Script version den 14 maj 2008 12:05:17
'Unrolls multiple surfaces/polysurfaces and puts a ID-tag at the center of each surface/polysurface
Call UnrollMulti()
Sub UnrollMulti()
Dim arrObjects, strObject, intID, intN, strSurface
intN = 0
intID = 0
arrObjects = Rhino.GetObjects("Pick srfs or polysrfs", 8+16,False,True, False)
If IsArray(arrObjects) Then For Each strObject In arrObjects
Dim lngColor, arrPoint, strCoordinates, strObject2, arrPoints, strText, strPoint, arrObject2, arrPoint2, strDot
'Make ID tag
intID = intID + 1
strText = CStr(intID)
'Get Color lngColor = Rhino.ObjectColor (strObject)
Call Rhino.EnableRedraw(False)
'Extract Surface if Object is Polysurface
If Rhino.ObjectType(strObject) = 16 Then
arrExpSrfs, intI, strObjectCopy
intI = 0
strObjectCopy = Rhino.CopyObject(strObject)
arrExpSrfs = Rhino.ExplodePolysurfaces (strObjectCopy)
Rhino.DeleteObject(strObjectCopy)
If isArray(arrExpSrfs) Then
For Each strSurface In arrExpSrfs
If intI > 0 Then
Rhino.DeleteObject(strSurface)
Else
'Get Center Coordinates for Extracted Srf
strSurface = Rhino.SelectObject (strSurface)
Rhino.Command "_PointsFromUV Normalized=Yes 0.5 0.5 Enter"
Rhino.DeleteObject strSurface
intN = intN+1
Rhino.Command "_SelNone"
Rhino.Command "_SelLast"
arrPoints = Rhino.SelectedObjects
End If intI = intI + 1
Next
End If
Else
'Get Center Coordinates for Srf
strSurface = Rhino.SelectObject (strObject)
Rhino.Command "_PointsFromUV Normalized=Yes 0.5 0.5 Enter"
intN = intN+1
Rhino.Command "_SelNone"
Rhino.Command "_SelLast"
arrPoints = Rhino.SelectedObjects
End If
If IsArray(arrPoints) Then
For Each strPoint In arrPoints
If Rhino.ObjectType(strPoint) = 1 Then
arrPoint = Rhino.PointCoordinates (strPoint)
DeleteObject strPoint
Else
Rhino.DeleteObject(strPoint)
End If
Next
End If
'Insert Dot1
Rhino.AddTextDot strText, arrPoint
Rhino.Command "_SelNone"
'Change Color of Dot1 strDot = Rhino.FirstObject
'Rhino.ObjectColor strDot, lngColor
' Rhino.MatchObjectAttributes strDot,strObject
Rhino.Command "_SelNone"
'Unroll
Rhino.SelectObject (strObject)
Rhino.Command "_UnrollSrf Enter Enter"
Rhino.Command "_SelNone"
Rhino.Command "_SelLast"
'Rhino.Command "Move 0,0,0 "
'Get Center Coordinates
arrObject2 = Rhino.SelectedObjects
Dim strNewObj
If IsArray(arrObject2) Then
For Each strObject2 In arrObject2
'Change Color
'Rhino.ObjectColor
strObject2, lngColor
'Rhino.MatchObjectAttributes strObject2,strObject
'Extract Surface if Object is Polysurface
If Rhino.ObjectType(strObject2) = 16 Then
intI = 0
arrExpSrfs = Rhino.ExplodePolysurfaces (strObject2)
If isArray(arrExpSrfs) Then
For Each strSurface In arrExpSrfs
If intI > 0 Then
Rhino.DeleteObject(strSurface)
Else
strNewObj = strSurface
End If
intI=intI+1
Next
End If
Else
strNewObj = Rhino.CopyObject(strObject2)
End If
Rhino.Command "_PointsFromUV Normalized=Yes 0.5 0.5 Enter"
Rhino.Command "_SelNone"
Rhino.Command "_SelLast"
arrPoints = Rhino.SelectedObjects
Rhino.DeleteObject(strNewObj)
Next
End If
If IsArray(arrPoints) Then
For Each strPoint In arrPoints
If Rhino.ObjectType(strPoint) = 1 Then
arrPoint2 = Rhino.PointCoordinates (strPoint)
Rhino.DeleteObject(strPoint)
End If
Next
End If
'Insert Dot2
'Rhino.AddTextDot strText, arrPoint2
Rhino.Command "_SelNone"
Dim strDot2
'Change Color of Dot2
strDot2 = Rhino.FirstObject
'Rhino.MatchObjectAttributes strDot2,strDot
'Rhino.ObjectColor strDot2, lngColor
Rhino.Command "_SelNone"
strObject = Rhino.FirstObject (True)
Rhino.NextObject strObject, True
Rhino.Command "Group"
Call Rhino.EnableRedraw(True)
Rhino.Command "Move 0,0,0 "
Rhino.UnselectAllObjects()
Next
End If
End Sub