Below is our first approach to a digital model. To reach this aim we follow the next steps:
1.representation of deformation on physical model in a 3D surface.
2.projection of slitting lines.
3.representing slit thickness with lines.
4.extrusion of lines along slitting lines.
This stage involves combining the 3 slit angles to create our model.
'Version december 3rd 2004
'Routines developed and copyrighted by Gelfling '04 aka. David Rutten
'Parts of these routines were developed while I was a intern at Prat-SA, Toulouse, France
'Surface relaxation using FDM (force density method) and VR(vibration reduction)
'(This method was written specifically for Rhinoceros 3.x and it's scripting engine.
'However only the interface section of the source code *requires* RhinoScript methods...)
'Internal mesh definitions differ from those required by the Rhinoceros 3.x Scripting engine.
'Instead of faces these routines use edges. Translation from one definition to the other
'will have to be performed prior to and after relaxation. Since only the coordinates
'of mesh vertices (or nodes) will be altered, this should be fairly straightforward.
'Furthermore in these routines vector objects play an important role. Vectors are arrays
'of 2 3D point definitions:
' Dim vecExample(1)
' vecExample(0) = Array(0,0,0) 'Starting point of vector
' vecExample(1) = Array(1,0,1) 'Ending point of vector
'Vector variables may be bigger than these dimensions but not smaller. They always need at
'least an x, y and z component.
Option Explicit
'This function performs a number of relaxation steps on the nodes of a mesh-definition.
'arrNodes is an array of 3D-points identifying the node coordinates in euclidian space
'arrConnections is an array of arrays containing information about connections between nodes
' Every index in the array is another array containing 2 numeric values:
' 0 = the index of the node where the connection links to
' 1 = the tension of the connection.
' Note that arrNodes and arrConnections must have the same size (every index describes a single node)
' Also note that if connections link to non-existent nodes an overflow error will occur.
' Then note that every node needs at least one connection, although logically 2 is the absolute minimum.
' Nodes can be connected to themselves, but this makes no sense so try to avoid it.
'arrConstrains is an array that describes the constrains a node can have in space.
' Every entry describes a single node. It can have the following values:
' Non-UUID string = the point is free to move in space if there is no object that has an ID which is identical
' to the supplied string. Using zero length strings to make sure nodes are free.
' UUID-String = the point is locked to an object (can be curve, surface or polysurface) by ClosestPoint
' (ClosestPoint routines are not included in this routine. Instead native Rhino 3.x script
' methods are called. If you intend to run this script on alternate platform you'll have to
' translate these calls into native methods. Also if other platforms use different object
' identifyers (instead of strings), you should make further alterations).
'Damping = a real number controlling the damping of the relaxation routine. Numbers higher than one
' will accelerate the relaxation, likely causing instable results. This however can be combatted by
' limiting the maximum distance nodes are allowed to travel. Numbers between zero and one will deccelerate
' the relaxation thus preventing bouncing solutions, but more steps will be required to reach a stable solution
' within tolerance. Negative numbers should be avoided.
'Limit = a real number controlling the distance every node is allowed to move during each iteration.
'Summary will be filled with an array of data regarding the details of the entire relaxation process
' it will be filled with the following values:
' 0 = The sum-total of distances of all node translations
' 1 = The biggest resultant vector in the set
'The return value of the function is an array identical to arrNodes but with different coordinates
Private Function RelaxMeshNodes(ByRef arrNodes, ByRef arrConnections, ByRef arrConstraints, ByVal Damping, ByVal Limit, ByRef Summary)
Dim i, j
Dim arrV(), resV
Dim newNodes
Dim ptCP
Dim maxResVec, curResVec
Dim sumNodeTrans
maxResVec = 0.0
sumNodeTrans = 0.0
newNodes = arrNodes
For i = 0 To UBound(newNodes)
If arrConstraints(i) <> "FIXED" Then
Erase arrV
ReDim arrV(UBound(arrConnections(i)))
For j = 0 To UBound(arrV)
arrV(j) = MultiplyVector(Array(newNodes(i), newNodes(arrConnections(i)(j)(0))), _
arrConnections(i)(j)(1))
Next
resV = ResultantVector(arrV)
resV = MultiplyVector(resV, Damping)
resV = LimitVector(resV, Limit)
If Rhino.IsObject(arrConstraints(i)) Then
If Rhino.IsCurve(arrConstraints(i)) Then
ptCP = Rhino.EvaluateCurve(arrConstraints(i), Rhino.CurveClosestPoint(arrConstraints(i), resV(1)))
ElseIf Rhino.IsBREP(arrConstraints(i)) Then
ptCP = Rhino.BrepClosestPoint(arrConstraints(i), resV(1))(0)
End If
If IsArray(ptCP) Then
newNodes(i) = ptCP
curResVec = PointPointDistance(newNodes(i), arrNodes(i))
If curResVec > maxResVec Then maxResVec = curResVec
sumNodeTrans = sumNodeTrans + curResVec
Else
newNodes(i) = resV(1)
curResVec = PointPointDistance(newNodes(i), arrNodes(i))
If curResVec > maxResVec Then maxResVec = curResVec
sumNodeTrans = sumNodeTrans + curResVec
End If
Else
newNodes(i) = resV(1)
curResVec = PointPointDistance(newNodes(i), arrNodes(i))
If curResVec > maxResVec Then maxResVec = curResVec
sumNodeTrans = sumNodeTrans + curResVec
End If
End If
Next
Summary = Array(sumNodeTrans, maxResVec)
RelaxMeshNodes = newNodes
End Function
Private Function PointPointDistance(ByRef arrPoint1, ByRef arrPoint2)
PointPointDistance = (arrPoint1(0)-arrPoint2(0)) * (arrPoint1(0)-arrPoint2(0)) + _
(arrPoint1(1)-arrPoint2(1)) * (arrPoint1(1)-arrPoint2(1)) + _
(arrPoint1(2)-arrPoint2(2)) * (arrPoint1(2)-arrPoint2(2))
PointPointDistance = Sqr(PointPointDistance)
End Function
'This function calculates the resultant vector of an array of vectors.
'The starting point of the first vector in the array will be used as grip
'for the resultant vector, if an invalid vector array is passed an error will occur
Private Function ResultantVector(ByRef arrVectors)
Dim i
Dim divX, divY, divZ
Dim resX, resY, resZ
Dim ptT(2), ptH(2)
resX = 0.0
resY = 0.0
resZ = 0.0
For i = 0 To UBound(arrVectors)
divX = arrVectors(i)(1)(0) - arrVectors(i)(0)(0)
divY = arrVectors(i)(1)(1) - arrVectors(i)(0)(1)
divZ = arrVectors(i)(1)(2) - arrVectors(i)(0)(2)
resX = resX + divX
resY = resY + divY
resZ = resZ + divZ
Next
ptT(0) = arrVectors(0)(0)(0)
ptT(1) = arrVectors(0)(0)(1)
ptT(2) = arrVectors(0)(0)(2)
ptH(0) = ptT(0) + resX
ptH(1) = ptT(1) + resY
ptH(2) = ptT(2) + resZ
ResultantVector = Array(ptT, ptH)
End Function
'This function will limit a vectorlength to a certain value
'vectors smaller than the specified length will remain untouched.
'Note that it is unhealthy to use negative numbers or zero for dblMaxLength
Private Function LimitVector(ByVal vecIn, ByVal dblLimitation)
Dim vecOut(1)
Dim l
vecOut(0) = vecIn(0)
vecOut(1) = vecIn(1)
l = PointPointDistance(vecIn(0), vecIn(1))
If l > dblLimitation Then
vecOut(1)(0) = vecOut(0)(0) + ((vecOut(1)(0)-vecOut(0)(0)) / l) * dblLimitation
vecOut(1)(1) = vecOut(0)(1) + ((vecOut(1)(1)-vecOut(0)(1)) / l) * dblLimitation
vecOut(1)(2) = vecOut(0)(2) + ((vecOut(1)(2)-vecOut(0)(2)) / l) * dblLimitation
End If
LimitVector = vecOut
End Function
'This function will multiply a vectorlength by a specified factor.
Private Function MultiplyVector(ByVal vecIn, ByVal dblFactor)
Dim vecOut(1)
vecOut(0) = vecIn(0)
vecOut(1) = vecIn(1)
vecOut(1)(0) = vecOut(0)(0) + (vecOut(1)(0) - vecOut(0)(0)) * dblFactor
vecOut(1)(1) = vecOut(0)(1) + (vecOut(1)(1) - vecOut(0)(1)) * dblFactor
vecOut(1)(2) = vecOut(0)(2) + (vecOut(1)(2) - vecOut(0)(2)) * dblFactor
MultiplyVector = vecOut
End Function
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
'---------------------Thus ends the mesh relaxation source code...-----------------------------
'--------------Below you will find an subroutine which implements the above routine-----------
'------------and also adds interface code. (This subroutine requires Rhinoceros 3.x)---------
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
'This function translates a Rhino Nurbs Surface definition into an FDM Mesh definition
'idSurface = The ID of the surface to convert. If the ID is invalid, Null will be returned
' If the surface is a non-compatible FDM object, Null will be returned
' Surface that are closed or periodic in the v-direction should not be used. Trims will be ignored.
'arrNodes = Points to a Variant variable that will recieve the Mesh Node data
'arrConnections = Points to a Variant variable that will recieve the Mesh Connectivity data
'arrConstraints = Points to a Variant variable that will recieve the Mesh Constraint data
'WarpTension = A double representing the tension of the fabric in Warp direction (U)
'WeftTension = A double representing the tension of the fabric in Weft direction (V)
'EdgeTension = An Array containing tension factor for all 4 surface edges 0=umin; 1=umax; 2=vmin; 3=vmax
'EdgeLinks = An Array containing constraint information for all four edges. Values can be:
' "FIXED" = Fixed edge
' objID = Linked edge
'= Free edge. String that are not "FIXED" and do not represent an object are automatically treated as free.
' Use "FREE" to skip a few steps in the relaxation loop
'TipLinks = An Array containing constraint information for all four tips. Values can be identical to EdgeLinks
' 0=umin,vmin; 1=umax,vmin; 2=umin,vmax; 3=umax,vmax
'If the function succeeds True will be returned, if the function fails Null will be returned.
Private Function NURBS2FDM(ByVal idSurface, ByRef arrNodes, ByRef arrFaces, _
ByRef arrConnections, ByRef arrConstraints, _
ByVal WarpTension, ByVal WeftTension, ByVal EdgeTension, _
ByVal EdgeLinks, ByVal TipLinks)
NURBS2FDM = Null
Dim u, v, N, M
Dim arrN(), arrF(), arrC(), arrL()
Dim rhPoints
Dim uCount, vCount
Dim uDegree, vDegree
Dim strChoice
rhPoints = Rhino.SurfacePoints(idSurface)
uCount = Rhino.SurfacePointCount(idSurface)(0)
vCount = Rhino.SurfacePointCount(idSurface)(1)
uDegree = Rhino.SurfaceDegree(idSurface, 0)
vDegree = Rhino.SurfaceDegree(idSurface, 1)
If Rhino.IsSurfacePeriodic(idSurface, 0) Then 'periodic in u-direction
'Set mesh nodes
ReDim arrN(vCount * (uCount-uDegree) - 1)
N = 0
For u = 0 To uCount - uDegree - 1
For v = 0 To vCount - 1
arrN(N) = rhPoints((u*vCount)+v)
N = N+1
Next
Next
ReDim arrF((vCount-1)*(uCount-uDegree)-1)
ReDim arrC(UBound(arrN))
ReDim arrL(UBound(arrN))
'Set mesh faces
N = 0
For u = 0 To uCount-uDegree-1
For v = 0 To vCount-2
arrF(N) = Array((u*vCount)+v, _
((u*vCount)+v+vCount) Mod ((uCount-uDegree)*vCount), _
((u*vCount)+v+vCount+1) Mod ((uCount-uDegree)*vCount), _
(u*vCount)+v+1)
N = N+1
Next
Next
'Set fabric
For u = 0 To uCount-uDegree-1
For v = 1 To vCount-2
N = (u*vCount)+v
arrC(N) = Array(Array(N+1, WeftTension), _
Array(N-1, WeftTension), _
Array(((N-vCount)+((uCount-uDegree)*vCount)) Mod ((uCount-uDegree)*vCount), WarpTension), _
Array((N+vCount) Mod ((uCount-uDegree)*vCount), WarpTension))
arrL(N) = "FREE"
Next
Next
'Set u-border edges
For u = 0 To (uCount-uDegree-1)*vCount Step vCount
N = u
arrC(N) = Array(Array((N+vCount) Mod ((uCount-uDegree)*vCount), EdgeTension(0)), _
Array((N-vCount+((uCount-uDegree)*vCount)) Mod ((uCount-uDegree)*vCount), EdgeTension(0)), _
Array(N+1, WeftTension))
arrL(N) = EdgeLinks(0)
N = u+vCount-1
arrC(N) = Array(Array((N+vCount+((uCount-uDegree)*vCount)) Mod ((uCount-uDegree)*vCount), EdgeTension(1)), _
Array((N-vCount+((uCount-uDegree)*vCount)) Mod ((uCount-uDegree)*vCount), EdgeTension(1)), _
Array(N-1, WeftTension))
arrL(N) = EdgeLinks(1)
Next
ElseIf Rhino.IsSurfaceClosed(idSurface, 0) Then 'closed in u direction
'Set mesh nodes
ReDim arrN(vCount * (uCount-1) - 1)
N = 0
For u = 0 To uCount - 2
For v = 0 To vCount - 1
arrN(N) = rhPoints((u*vCount)+v)
N = N+1
Next
Next
ReDim arrF((vCount-1)*(uCount-1)-1)
ReDim arrC(UBound(arrN))
ReDim arrL(UBound(arrN))
'Set mesh faces
N = 0
For u = 0 To uCount-2
For v = 0 To vCount-2
arrF(N) = Array((u*vCount)+v, _
((u*vCount)+v+vCount) Mod ((uCount-1)*vCount), _
((u*vCount)+v+vCount+1) Mod ((uCount-1)*vCount), _
(u*vCount)+v+1)
N = N+1
Next
Next
'Set fabric
For u = 0 To uCount-2
For v = 1 To vCount-2
N = (u*vCount)+v
arrC(N) = Array(Array(N+1, WeftTension), _
Array(N-1, WeftTension), _
Array(((N-vCount)+((uCount-1)*vCount)) Mod ((uCount-1)*vCount), WarpTension), _
Array((N+vCount) Mod ((uCount-1)*vCount), WarpTension))
arrL(N) = "FREE"
Next
Next
'Set u-border edges
For u = 0 To (uCount-2)*vCount Step vCount
N = u
arrC(N) = Array(Array((N+vCount) Mod ((uCount-1)*vCount), EdgeTension(0)), _
Array((N-vCount+((uCount-1)*vCount)) Mod ((uCount-1)*vCount), EdgeTension(0)), _
Array(N+1, WeftTension))
arrL(N) = EdgeLinks(0)
N = u+vCount-1
arrC(N) = Array(Array((N+vCount+((uCount-1)*vCount)) Mod ((uCount-1)*vCount), EdgeTension(1)), _
Array((N-vCount+((uCount-1)*vCount)) Mod ((uCount-1)*vCount), EdgeTension(1)), _
Array(N-1, WeftTension))
arrL(N) = EdgeLinks(1)
Next
Else 'rectangular patch
'Set mesh nodes
ReDim arrN(UBound(rhPoints))
For N = 0 To UBound(rhPoints)
arrN(N) = rhPoints(N)
Next
'Set mesh faces
ReDim arrF((uCount-1)*(vCount-1)-1)
N = 0
For u = 0 To uCount-2
For v = 0 To vCount-2
arrF(N) = Array((u*vCount)+v, (u*vCount)+v+vCount, (u*vCount)+v+1+vCount, (u*vCount)+v+1)
N = N+1
Next
Next
'Set connections and link-constraints
ReDim arrC(UBound(arrN))
ReDim arrL(UBound(arrN))
For N = 0 To UBound(arrN)
arrC(N) = Array(Array(N+1, WeftTension), Array(N-1, WeftTension), _
Array(N-vCount, WarpTension), Array(N+vCount, WarpTension))
arrL(N) = "FREE"
Next
'Set u-border edge cables
For N = 0 To vCount*(uCount-1) Step vCount
arrC(N) = Array(Array(N+vCount, EdgeTension(0)), Array(N-vCount, EdgeTension(0)), Array(N+1, WeftTension))
arrL(N) = EdgeLinks(0)
M = N+vCount-1
arrC(M) = Array(Array(M+vCount, EdgeTension(1)), Array(M-vCount, EdgeTension(1)), Array(M-1, WeftTension))
arrL(M) = EdgeLinks(1)
Next
'Set v-border edge cables
For N = 0 To vCount-1
arrC(N) = Array(Array(N+vCount, WarpTension), Array(N+1, EdgeTension(2)), Array(N-1, EdgeTension(2)))
arrL(N) = EdgeLinks(2)
M = N + (uCount-1)*vCount
arrC(M) = Array(Array(M-vCount, WarpTension), Array(M-1, EdgeTension(3)), Array(M+1, EdgeTension(3)))
arrL(M) = EdgeLinks(3)
Next
'Set tips
arrC(0) = Array(Array(1,EdgeTension(2)), Array(uCount, EdgeTension(0)))
arrL(0) = TipLinks(0)
arrC(vCount-1) = Array(Array(vCount-2, EdgeTension(2)), Array(2*vCount-1, EdgeTension(1)))
arrL(vCount-1) = TipLinks(2)
arrC(vCount*(uCount-1)) = Array(Array(vCount*(uCount-1)+1, EdgeTension(3)), Array(vCount*(uCount-2), EdgeTension(0)))
arrL(vCount*(uCount-1)) = TipLinks(1)
arrC(vCount*uCount-1) = Array(Array(vCount*uCount-2, EdgeTension(3)), Array(vCount*(uCount-1)-1, EdgeTension(1)))
arrL(vCount*uCount-1) = TipLinks(3)
End If
arrNodes = arrN
arrFaces = arrF
arrConnections = arrC
arrConstraints = arrL
NURBS2FDM = True
End Function
Private Function RecreateFDMSurface(idSurface, arrNodes)
Dim newNodes()
Dim u, v, N, index
Dim Nu, Nv, Du
Nu = Rhino.SurfacePointCount(idSurface)(0)
Nv = Rhino.SurfacePointCount(idSurface)(1)
Du = Rhino.SurfaceDegree(idSurface, 0)
ReDim newNodes(Nu*Nv-1)
If Rhino.IsSurfacePeriodic(idSurface, 0) Then
N = 0
For u = 0 To Nu-1
For v = 0 To Nv-1
index = (u*Nv+v) Mod ((Nu-Du)*Nv)
newNodes(N) = arrNodes(index)
N = N+1
Next
Next
ElseIf Rhino.IsSurfaceClosed(idSurface, 0) Then
N = 0
For u = 0 To Nu-1
For v = 0 To Nv-1
index = (u*Nv+v) Mod ((Nu-1)*Nv)
newNodes(N) = arrNodes(index)
N = N+1
Next
Next
Else
For N = 0 To UBound(arrNodes)
newNodes(N) = arrNodes(N)
Next
End If
RecreateFDMSurface = Rhino.AddNurbsSurface(Rhino.SurfacePointCount(idSurface), _
newNodes, _
Rhino.SurfaceKnots(idSurface)(0), _
Rhino.SurfaceKnots(idSurface)(1), _
Rhino.SurfaceDegree(idSurface), _
Rhino.SurfaceWeights(idSurface))
End Function
'This function displays a message at the command line, blinks it with a red background colour and then offers a set of options.
'Might be handy to use for feedback...
Private Function FlashMessage(strMessage, arrOptions)
Dim rgbCurrent, rgbFlash
Dim lngFlashPause
lngFlashPause = 175
rgbCurrent = Rhino.AppearanceColor(12)
rgbFlash = RGB(255,0,0)
Rhino.Prompt strMessage
Rhino.AppearanceColor 12, rgbFlash
Rhino.Sleep lngFlashPause
Rhino.AppearanceColor 12, rgbCurrent
Rhino.Sleep lngFlashPause
Rhino.AppearanceColor 12, rgbFlash
Rhino.Sleep lngFlashPause
Rhino.AppearanceColor 12, rgbCurrent
FlashMessage = Rhino.GetString(strMessage, "", arrOptions)
End Function
'This function creates 4 textdots at the surface corners and prompts the user to pick some.
'You have to remove the objects again by calling the function CLEARPREVIEW afterwards.
'The return value is an array that contains the indices of the edges or NULL on error/nopick
'0=umin,vmin 1=umax,vmin 2=umin,vmax 3=umax,vmax
Private Function GetTips(ByVal idSurface, ByVal strPrompt)
GetTips = Null
Dim arrDots(3), selDots
Dim srfDomain, i, j
Dim arrAll(), S
If Rhino.IsSurfacePeriodic(idSurface, 0) Or Rhino.IsSurfacePeriodic(idSurface, 1) Or _
Rhino.IsSurfaceClosed(idSurface, 0) Or Rhino.IsSurfaceClosed(idSurface, 1) Then
FlashMessage "The surface has no corners... You'll need to fix or link the edges instead.", Array("OK")
Else
srfDomain = Array(Rhino.SurfaceDomain(idSurface,0), Rhino.SurfaceDomain(idSurface,1))
arrDots(0) = Rhino.AddTextDot("A", Rhino.EvaluateSurface(idSurface, Array(srfDomain(0)(0), srfDomain(1)(0))))
arrDots(1) = Rhino.AddTextDot("B", Rhino.EvaluateSurface(idSurface, Array(srfDomain(0)(1), srfDomain(1)(0))))
arrDots(2) = Rhino.AddTextDot("C", Rhino.EvaluateSurface(idSurface, Array(srfDomain(0)(0), srfDomain(1)(1))))
arrDots(3) = Rhino.AddTextDot("D", Rhino.EvaluateSurface(idSurface, Array(srfDomain(0)(1), srfDomain(1)(1))))
Rhino.ObjectName arrDots, "GelflingRelaxationPreviewObjects"
selDots = Rhino.GetObjects(strPrompt, 0, False, False, True, arrDots)
If IsNull(selDots) Then Exit Function
S = 0
For i = 0 To UBound(selDots)
For j = 0 To 3
If selDots(i) = arrDots(j) Then
ReDim Preserve arrAll(S)
arrAll(S) = j
S = S+1
End If
Next
Next
GetTips = arrAll
End If
End Function
'This function is a wrapper for the Rhino.ExtractIsoCurve method. Differences:
'- it returns only a single ID instead of an array.
'-if the extracted edge is very short a point will be drawn instead.
Private Function ExtractIsoCurveWrapper(ByVal idSurface, ByVal arrParam, ByVal Direction)
Dim varResult
varResult = Rhino.ExtractIsoCurve(idSurface, arrParam, Direction)
If IsNull(varResult) Then
ExtractIsoCurveWrapper = Rhino.AddPoint(Rhino.EvaluateSurface(idSurface, arrParam))
If IsNull(ExtractIsoCurveWrapper) Then ExtractIsoCurveWrapper = "null-object"
ElseIf Rhino.CurveLength(varResult(0)) <= Rhino.UnitAbsoluteTolerance Then Rhino.DeleteObject varResult(0) ExtractIsoCurveWrapper = Rhino.AddPoint(Rhino.EvaluateSurface(idSurface, arrParam)) If IsNull(ExtractIsoCurveWrapper) Then ExtractIsoCurveWrapper = "null-object" Else ExtractIsoCurveWrapper = varResult(0) End If End Function 'This function copies the edges of a surface and prompts the user to pick some. 'The return value is an array with edge indices or NULL on error/nopick '0=umin 1=umax 2=vmin 3=vmax Private Function GetEdges(ByVal idSurface, ByVal strPrompt) GetEdges = Null Dim arrEdges(3), selEdges Dim srfDomain(1), midDomain(1) Dim i, j Dim arrAll(), S srfDomain(0) = Rhino.SurfaceDomain(idSurface,0) midDomain(0) = (srfDomain(0)(0) + srfDomain(0)(1))/2 srfDomain(1) = Rhino.SurfaceDomain(idSurface,1) midDomain(1) = (srfDomain(1)(0) + srfDomain(1)(1))/2 If Rhino.IsSurfacePeriodic(idSurface, 1) Or Rhino.IsSurfaceClosed(idSurface, 1) Then arrEdges(2) = ExtractIsoCurveWrapper(idSurface, Array(srfDomain(0)(0), midDomain(1)), 1) arrEdges(3) = ExtractIsoCurveWrapper(idSurface, Array(srfDomain(0)(1), midDomain(1)), 1) ElseIf Rhino.IsSurfacePeriodic(idSurface, 0) Or Rhino.IsSurfaceClosed(idSurface, 0) Then arrEdges(0) = ExtractIsoCurveWrapper(idSurface, Array(midDomain(0), srfDomain(1)(0)), 0) arrEdges(1) = ExtractIsoCurveWrapper(idSurface, Array(midDomain(0), srfDomain(1)(1)), 0) Else arrEdges(0) = ExtractIsoCurveWrapper(idSurface, Array(midDomain(0), srfDomain(1)(0)), 0) arrEdges(1) = ExtractIsoCurveWrapper(idSurface, Array(midDomain(0), srfDomain(1)(1)), 0) arrEdges(2) = ExtractIsoCurveWrapper(idSurface, Array(srfDomain(0)(0), midDomain(1)), 1) arrEdges(3) = ExtractIsoCurveWrapper(idSurface, Array(srfDomain(0)(1), midDomain(1)), 1) End If For i = 0 To 3 If IsNull(arrEdges(i)) Or IsEmpty(arrEdges(i)) Then arrEdges(i) = "null-object" Next Rhino.ObjectName arrEdges, "GelflingRelaxationPreviewObjects" selEdges = Rhino.GetObjects(strPrompt, 0, False, False, True, arrEdges) If IsNull(selEdges) Then Exit Function S = 0 For i = 0 To UBound(selEdges) For j = 0 To 3 If selEdges(i) = arrEdges(j) Then ReDim Preserve arrAll(S) arrAll(S) = j S = S+1 End If Next Next GetEdges = arrAll End Function 'This function draws a set of curves on a surface, either in U/warp or V/weft 'You have to call the CLEARPREVIEW function to remove the curves again afterwards. Private Sub DrawWarpWeftPreview(ByVal strSurface, ByVal intDirection, ByVal dblDensity) Dim uDomain, vDomain Dim i, u, v Dim crvAdd uDomain = Rhino.SurfaceDomain(strSurface, 0) vDomain = Rhino.SurfaceDomain(strSurface, 1) Rhino.EnableRedraw False For i = 0 To 1 Step 1/dblDensity u = uDomain(0) + (uDomain(1)-uDomain(0))*i v = vDomain(0) + (vDomain(1)-vDomain(0))*i crvAdd = Rhino.ExtractIsoCurve(strSurface, Array(u,v), intDirection) Rhino.ObjectName crvAdd, "GelflingRelaxationPreviewObjects" Next Rhino.EnableRedraw True End Sub 'This function removes all objects from the document that have been created by functions in this script. 'Basically it removes all objects that are named "GelflingRelaxationPreviewObjects" Private Sub ClearPreview() Dim allPreviewObjects allPreviewObjects = Rhino.ObjectsByName("GelflingRelaxationPreviewObjects", False) If IsNull(allPreviewObjects) Then Exit Sub Rhino.DeleteObjects allPreviewObjects End Sub 'This function checks a surface to see whether it is suitablefor FDM relaxation. 'If it turns out not to be, then it will prompt the user for action. 'If the surface could not be or was not fixed NULL will be returned. 'If the surface is acceptable or was fixed the new ID will be returned Private Function CheckNURBSSurface(ByVal idSurface) CheckNURBSSurface = Null Dim strResult Dim idNewSurface idNewSurface = idSurface If Not Rhino.IsSurface(idNewSurface) Then Exit Function If (Rhino.IsSurfaceClosed(idSurface,0) Or Rhino.IsSurfacePeriodic(idSurface,0)) And _ (Rhino.IsSurfaceClosed(idSurface,1) Or Rhino.IsSurfacePeriodic(idSurface,1)) Then strResult = FlashMessage("The surface you selected has no free edges. Relaxation is not possible.", Array("OK")) Exit Function End If If Rhino.SurfacePointCount(idNewSurface)(0) <= 3 Or Rhino.SurfacePointCount(idSurface)(1) <=3 Then strResult = FlashMessage("The surface you selected does not have sufficient grips.", Array("OK")) Exit Function End If ' If Rhino.IsSurfaceRational(idSurface) Then ' strResult = FlashMessage("The surface you selected is rational. Weighted grips will not translate correctly, what would you like to do?", _ ' Array("Unweight", "Ignore", "Abort")) ' If IsNull(strResult) Then Exit Function ' Select Case UCase(strResult) ' Case "UNWEIGHT" ' idNewSurface = Rhino.AddNurbsSurface(Rhino.SurfacePointCount(idNewSurface), _ ' Rhino.SurfacePoints(idNewSurface), _ ' Rhino.SurfaceKnots(idNewSurface)(0), _ ' Rhino.SurfaceKnots(idNewSurface)(1), _ ' Rhino.SurfaceDegree(idNewSurface)) ' Rhino.DeleteObject idSurface ' Case "IGNORE" ' 'Do not take any action ' Case Else ' Exit Function ' End Select ' End If If Rhino.IsSurfaceTrimmed(idNewSurface) Then strResult = FlashMessage("The surface you selected is trimmed. Trims are not supported, what would you like to do?", Array("Untrim", "Ignore", "Abort")) If IsNull(strResult) Then Exit Function Select Case UCase(strResult) Case "UNTRIM" idNewSurface = Rhino.AddNurbsSurface(Rhino.SurfacePointCount(idNewSurface), _ Rhino.SurfacePoints(idNewSurface), _ Rhino.SurfaceKnots(idNewSurface)(0), _ Rhino.SurfaceKnots(idNewSurface)(1), _ Rhino.SurfaceDegree(idNewSurface), _ Rhino.SurfaceWeights(idNewSurface)) Rhino.DeleteObject idSurface Case "IGNORE" 'Do not take any action Case Else Exit Function End Select End If If Rhino.IsSurfacePeriodic(idNewSurface, 1) Then strResult = FlashMessage("Only u-periodic surfaces are supported, what would you like to do?", Array("Swap_UV_Directions", "Abort")) If IsNull(strResult) Then Exit Function If UCase(strResult) = "ABORT" Then Exit Function Rhino.EnableRedraw vbFalse Rhino.UnselectAllObjects Rhino.SelectObject idNewSurface Rhino.Command "-_Dir _SwapUV _Enter", vbFalse Rhino.EnableRedraw vbTrue End If If Rhino.IsSurfaceClosed(idNewSurface, 1) Then strResult = FlashMessage("Only u-continues surfaces are supported, what would you like to do?", Array("Swap_UV_Directions", "Abort")) If IsNull(strResult) Then Exit Function If UCase(strResult) = "ABORT" Then Exit Function Rhino.EnableRedraw vbFalse Rhino.UnselectAllObjects Rhino.SelectObject idNewSurface Rhino.Command "-_Dir _SwapUV _Enter", vbFalse Rhino.EnableRedraw vbTrue End If CheckNURBSSurface = idNewSurface End Function 'This is it. The main sub... Private Sub RelaxNURBS_Surface() Dim arrNodes, arrFaces, arrConnections, arrConstraints Dim EdgeTension(3), WarpTension, WeftTension Dim EdgeLink(3), TipLink(3) Dim strSurfaceID, newSurfaceID Dim MeshID Dim DampingFactor, Limitation, PreflightLoops, AccuracyMark, LimitationDecay Dim Summary Dim srfBBox, Diagonal Dim RunAsDeveloper, DestinationFolder, FramePrefix, FrameFormat, FrameDim(1) 'Set to TRUE to save an animation sequence of the relaxation process. RunAsDeveloper = False strSurfaceID = Rhino.GetObject("Select a surface for relaxation", 8, True, True) If IsNull(strSurfaceID) Then Exit Sub strSurfaceID = CheckNURBSSurface(strSurfaceID) If IsNull(strSurfaceID) Then Rhino.Print "Relaxation process aborted due to improper geometry..." Exit Sub End If Rhino.SurfaceIsoCurveDensity strSurfaceID, -1 If Not IsNull(Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "LastOperation")) Then EdgeTension(0) = CDbl(Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "EdgeTension0")) EdgeTension(1) = CDbl(Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "EdgeTension1")) EdgeTension(2) = CDbl(Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "EdgeTension2")) EdgeTension(3) = CDbl(Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "EdgeTension3")) WarpTension = CDbl(Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "WarpTension")) WeftTension = CDbl(Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "WeftTension")) EdgeLink(0) = Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "EdgeLink0") EdgeLink(1) = Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "EdgeLink1") EdgeLink(2) = Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "EdgeLink2") EdgeLink(3) = Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "EdgeLink3") TipLink(0) = Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "TipLink0") TipLink(1) = Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "TipLink1") TipLink(2) = Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "TipLink2") TipLink(3) = Rhino.GetObjectData(strSurfaceID, "Gelfling_Relaxation", "TipLink3") Else WarpTension = 1.0 WeftTension = 1.0 For i = 0 To 3 EdgeTension(i) = 10.0 EdgeLink(i) = "FREE" TipLink(i) = "FIXED" Next If Rhino.IsSurfacePeriodic(strSurfaceID, 0) Or Rhino.IsSurfaceClosed(strSurfaceID, 0) Then For i = 0 To 3 EdgeLink(i) = "FIXED" Next End If End If Rhino.Prompt "Loading geometry... please wait" Summary = NURBS2FDM(strSurfaceID, arrNodes, arrFaces, arrConnections, arrConstraints, _ WarpTension, WeftTension, EdgeTension, EdgeLink, TipLink) If IsNull(Summary) Then MsgBox "Error in building FDM mesh.", vbOKOnly Or vbCritical, "Relaxation error" Exit Sub End If Dim arrOptions, strResult Dim intObject, i, N Dim idParent Do If RunAsDeveloper Then arrOptions = Array("Tension_Factors", "Geometry_Links", "Summary", "Relax", "Relax_advanced", "Quit") Else arrOptions = Array("Tension_Factors", "Geometry_Links", "Relax", "Quit") End If strResult = Rhino.GetString("Relaxation settings", "Relax", arrOptions) If IsNull(strResult) Then Exit Sub Select Case Left(UCase(strResult),1) Case "M" If UCase(strResult) = "MELLON" Then RunAsDeveloper = True Case "T" Do arrOptions = Array("Warp", "Weft", "Edges", "Return") strResult = Rhino.GetString("Fabric tension factor properties", "Return", arrOptions) If IsNull(strResult) Then strResult = "Return" Select Case Left(UCase(strResult), 2) Case "WA" DrawWarpWeftPreview strSurfaceID, 0, 30 strResult = Rhino.GetReal("Specify a new fabric warp tension", WarpTension, 0.01, 1000) If Not IsNull(strResult) Then WarpTension = CDbl(strResult) End If ClearPreview Case "WE" DrawWarpWeftPreview strSurfaceID, 1, 30 strResult = Rhino.GetReal("Specify a new fabric weft tension", WeftTension, 0.01, 1000) If Not IsNull(strResult) Then WeftTension = CDbl(strResult) End If ClearPreview Case "ED" intObject = GetEdges(strSurfaceID, "Select edges to set tension") If IsArray(intObject) Then strResult = Rhino.GetReal("Specify a new edge cable tension", EdgeTension(intObject(0)), 0.01, 1000) If Not IsNull(strResult) Then For i = 0 To UBound(intObject) EdgeTension(intObject(i)) = CDbl(strResult) Next End If End If ClearPreview Case Else Exit Do End Select Loop Case "G" Do arrOptions = Array("Corners", "Edges", "Return") strResult = Rhino.GetString("Surface geometry linking options", "Return", arrOptions) If IsNull(strResult) Then strResult = "Return" Select Case Left(UCase(strResult), 1) Case "C" intObject = GetTips(strSurfaceID, "Select corners to restrain") If IsArray(intObject) Then arrOptions = Array("Fixed", "Linked") strResult = Rhino.GetString("Pick a node restraint type", "Fixed", arrOptions) If Not IsNull(strResult) Then Select Case Left(UCase(strResult),2) Case "LI" idParent = Rhino.GetObject("Select a guide object", 4+8+16, False, True) If Not IsNull(idParent) Then For i = 0 To UBound(intObject) TipLink(intObject(i)) = idParent Next End If Case Else For i = 0 To UBound(intObject) TipLink(intObject(i)) = "FIXED" Next End Select End If End If ClearPreview Rhino.UnSelectAllObjects Case "E" intObject = GetEdges(strSurfaceID, "Select edges to restrain") If IsArray(intObject) Then arrOptions = Array("Fixed", "Free", "Linked") strResult = Rhino.GetString("Edge restraint type?", "Fixed", arrOptions) If Not IsNull(strResult) Then Select Case Left(UCase(strResult),2) Case "FR" For i = 0 To UBound(intObject) EdgeLink(intObject(i)) = "" Next Case "LI" idParent = Rhino.GetObject("Select a guide object", 4+8+16, False, False) If Not IsNull(idParent) Then For i = 0 To UBound(intObject) EdgeLink(intObject(i)) = idParent Next End If Case Else For i = 0 To UBound(intObject) EdgeLink(intObject(i)) = "FIXED" Next End Select End If End If ClearPreview Rhino.UnSelectAllObjects Case Else Exit Do End Select Loop Case "S" N = 0 For i = 0 To UBound(arrConnections) N = N + UBound(arrConnections(i))+1 Next MsgBox "NURBS surface relaxation data for object; " & vbNewLine & _ "[" & strSurfaceID & "]" & vbNewLine & vbNewLine & _ "Mesh node count; " & UBound(arrNodes)+1 & vbNewLine & _ "Mesh face count; " & UBound(arrFaces)+1 & vbNewLine & _ "Mesh link count; " & N & vbNewLine & _ "Fabric warp-tension; " & WarpTension & "%" & vbNewLine & _ "Fabric weft-tension; " & WeftTension & "%" & vbNewLine & _ "Fabric edge-tension(0); " & EdgeTension(0) & "% (" & EdgeLink(0) & ")" & vbNewLine & _ "Fabric edge-tension(1); " & EdgeTension(1) & "% (" & EdgeLink(1) & ")" & vbNewLine & _ "Fabric edge-tension(2); " & EdgeTension(2) & "% (" & EdgeLink(2) & ")" & vbNewLine & _ "Fabric edge-tension(3); " & EdgeTension(3) & "% (" & EdgeLink(3) & ")" & vbNewLine & _ "Fabric corner-link(A); " & TipLink(0) & vbNewLine & _ "Fabric corner-link(B); " & TipLink(1) & vbNewLine & _ "Fabric corner-link(C); " & TipLink(2) & vbNewLine & _ "Fabric corner-link(D); " & TipLink(3) & vbNewLine & vbNewLine & _ "end of summary...", vbOKOnly, "FDM-mesh summary" Case "R" srfBBox = Rhino.BoundingBox(strSurfaceID) Diagonal = PointPointDistance(srfBBox(0), srfBBox(6)) If Len(strResult) = 14 Then AccuracyMark = Rhino.GetReal("Specify relaxation tolerance", Rhino.UnitAbsoluteTolerance, Rhino.UnitAbsoluteTolerance/100) DampingFactor = Rhino.GetReal("Specify a global damping factor", 1.0, 0.001, 1000.0) Limitation = Rhino.GetReal("Specify an initial translation limitation", Round(Diagonal * 0.05,2), AccuracyMark, Diagonal*10) LimitationDecay = Rhino.GetReal("Specify a translation limitation decay factor per iteration", 0.95, 0.1, 0.99) PreflightLoops = Rhino.GetInteger("Specify the number of preflight-iterations", 20, 1, 1000) If IsNull(AccuracyMark) Then AccuracyMark = Rhino.UnitAbsoluteTolerance If IsNull(DampingFactor) Then DampingFactor = 1.0 If IsNull(Limitation) Then Limitation = Diagonal * 0.05 If IsNull(LimitationDecay) Then LimitationDecay = 0.95 If IsNull(PreflightLoops) Then PreflightLoops = 20 Else DampingFactor = 1.0 Limitation = Diagonal * 0.05 PreflightLoops = 20 AccuracyMark = Rhino.UnitAbsoluteTolerance LimitationDecay = 0.95 End If Exit Do Case "Q" Exit Sub Case Else Rhino.Print "Unknown command entered... nothing done." End Select Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "LastOperation", CStr(Now) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "EdgeTension0", CStr(EdgeTension(0)) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "EdgeTension1", CStr(EdgeTension(1)) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "EdgeTension2", CStr(EdgeTension(2)) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "EdgeTension3", CStr(EdgeTension(3)) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "WarpTension", CStr(WarpTension) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "WeftTension", CStr(WeftTension) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "EdgeLink0", EdgeLink(0) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "EdgeLink1", EdgeLink(1) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "EdgeLink2", EdgeLink(2) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "EdgeLink3", EdgeLink(3) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "TipLink0", TipLink(0) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "TipLink1", TipLink(1) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "TipLink2", TipLink(2) Rhino.SetObjectData strSurfaceID, "Gelfling_Relaxation", "TipLink3", TipLink(3) Loop Rhino.UnSelectAllObjects Rhino.HideObject strSurfaceID Summary = NURBS2FDM(strSurfaceID, arrNodes, arrFaces, arrConnections, arrConstraints, _ WarpTension, WeftTension, EdgeTension, EdgeLink, TipLink) If IsNull(Summary) Then MsgBox "The surface could not be translated into an FDM-mesh."& vbNewLine & _ "The fact that you're seeing this warning means there" & vbNewLine & _ "is a bug in the script. Please mail your surface file" & vbNewLine & _ "(*.3dm fileformat) to david@rutten.as", vbOKOnly Or vbCritical, "Relaxation routine bug" Exit Sub End If Rhino.Command "-_AdvancedDisplay _Wires _ShowMeshWires=Yes _Enter _Enter", vbFalse MeshID = Rhino.AddMesh(arrNodes, arrFaces) DestinationFolder = Null If RunAsDeveloper Then DestinationFolder = Rhino.BrowseForFolder(,"Select a folder to save the animation sequence. Press 'Cancel' to not save animation.", "Animation settings") If Not IsNull(DestinationFolder) Then FramePrefix = Rhino.StringBox("Enter a name for the sequence...", "RelaxationFrame", "Animation settings") If IsNull(FramePrefix) Then DestinationFolder = Null Else FrameFormat = Rhino.ListBox(Array("bmp", "tga", "pcx", "jpg", "png", "tif"), "Select a file format", "Animation settings") If IsNull(FrameFormat) Then DestinationFolder = Null Else Summary = Rhino.PropertyListBox(Array("Animation width", "Animation height"), _ Array("1500", "1000"), "Enter frame dimensions", "Animation settings") If IsNull(Summary) Then DestinationFolder = Null Else FrameDim(0) = Summary(0) FrameDim(1) = Summary(1) End If End If End If If Not IsNull(DestinationFolder) Then Rhino.Command "-_TestViewCaptureToFile " & Chr(34) & DestinationFolder & FramePrefix & "00000." & FrameFormat & Chr(34) & _ " _Width=" & FrameDim(0) & " _Height=" & FrameDim(1) &" _DrawCplane=No _DrawWorldAxes=No _Enter", vbFalse End If End If End If 'Analyse current FDM mesh properties Rhino.Prompt "Performing test relaxation run... please wait" RelaxMeshNodes arrNodes, arrConnections, arrConstraints, DampingFactor, Limitation, Summary Rhino.Print "Initial cumulative node translation: " & Round(Summary(0)) & Rhino.UnitSystemName(False, True, True) & _ " Initial largest node vector: " & Round(Summary(1), 2) & " N" 'Perform preflight relaxation For i = 1 To PreflightLoops Rhino.Prompt "Performing preflight relaxation. Step " & i & " of " & PreflightLoops & "..." arrNodes = RelaxMeshNodes(arrNodes, arrConnections, arrConstraints, DampingFactor, Limitation, Summary) Rhino.EnableRedraw vbFalse Rhino.DeleteObject MeshID MeshID = Rhino.AddMesh(arrNodes, arrFaces) Rhino.EnableRedraw vbTrue If Not IsNull(DestinationFolder) Then Rhino.Command "-_TestViewCaptureToFile " & Chr(34) & DestinationFolder & FramePrefix & Right("00000" & i, 5) & "." & FrameFormat & Chr(34) & _ " _Width=" & FrameDim(0) & " _Height=" & FrameDim(1) & " _DrawCplane=No _DrawWorldAxes=No _Enter", vbFalse End If Next 'Perform damped relaxation Do arrNodes = RelaxMeshNodes(arrNodes, arrConnections, arrConstraints, DampingFactor, Limitation, Summary) Rhino.Prompt "Iteration " & i & _ " Damping: " & Round(DampingFactor*100, 2) & "%" & _ " Limitation: " & Round(Limitation, 2) & Rhino.UnitSystemName(False, True, True) Limitation = Limitation * LimitationDecay 'DampingFactor = DampingFactor * 0.98 Rhino.EnableRedraw vbFalse Rhino.DeleteObject MeshID MeshID = Rhino.AddMesh(arrNodes, arrFaces) Rhino.EnableRedraw vbTrue If Not IsNull(DestinationFolder) Then Rhino.Command "-_TestViewCaptureToFile " & Chr(34) & DestinationFolder & FramePrefix & Right("00000" & i, 5) & "." & FrameFormat & Chr(34) & _ " _Width=" & FrameDim(0) & " _Height=" & FrameDim(1) &" _DrawCplane=No _DrawWorldAxes=No _Enter", vbFalse End If If Limitation < i =" i+1" newsurfaceid =" RecreateFDMSurface(strSurfaceID,">
