(n)certainties

Call Main()
Sub Main()
Dim strMesh : strMesh = Rhino.GetObject("select the mesh to melt",32)
Call MeltMesh (strMesh, 5, False, True)
End Sub

Function MeltMesh (strMesh, dblHowMuch, blnRelax, blnMakeZLess)

MeltMesh = Null
If Not Rhino.IsMesh(strMesh) Then Exit Function
If Not IsNumeric(dblHowMuch) Then Exit Function

Dim arrMeshVertices : arrMeshVertices = Rhino.MeshVertices (strMesh)
Dim arrMeshFaceVertices : arrMeshFaceVertices = Rhino.MeshFaceVertices(strMesh)
If Not IsArray(arrMeshVertices) Then Exit Function
If Not IsArray(arrMeshFaceVertices) Then Exit Function

Dim arrNewVertices : arrNewVertices = arrMeshVertices
Dim i , e
For i=0 To Ubound(arrMeshVertices)
For e = 0 To arrMeshVertices(i)(0) Step 0.7 ''''''''''''''''
If blnRelax Then
Dim arrAdjacentVtxIndexes : arrAdjacentVtxIndexes = MeshVtxAdjacentVtxs (strMesh, i, True, False)
Dim j
Dim arrAdjacentVtxs : arrAdjacentVtxs = arrAdjacentVtxIndexes
For j=0 To Ubound(arrAdjacentVtxIndexes)
arrAdjacentVtxs(j) = arrMeshVertices(arrAdjacentVtxIndexes(j))
Next

arrNewVertices(i) = RelaxPt(arrNewVertices(i), arrAdjacentVtxs, 0.1) '''''''''''''''''''''''''''
End If
If blnMakeZLess Then
arrNewVertices(i) = MakeZLess (arrNewVertices(i), 0.97) '''''''''''''''''''''''''''''''''''
End If
'arrNewVertices(i) = array(arrMeshVertices(i)(0), arrMeshVertices(i)(1)*arrMeshVertices(i)(0), arrMeshVertices(i)(2)/arrMeshVertices(i)(0))
Next
Next

Dim strNewMesh : strNewMesh = Rhino.AddMesh (arrNewVertices, arrMeshFaceVertices)

If strNewMesh = Null Then Exit Function
MeltMesh = strNewMesh
End Function

Function MakeZLess (arrpt, dblPercentage)

MakeZLess = array( arrPt(0), arrPt(1), arrPt(2)*dblPercentage)
End Function

Function RelaxPt(arrOrigin, arrPts, dblHowMuch)
RelaxPt = Null

Dim arrResultingVector : arrResultingVector = array(0,0,0)
Dim arrPt
For Each arrPt In arrPts
Dim arrCurrentVector : arrCurrentVector = Rhino.VectorCreate(arrPt, arrOrigin)
arrCurrentVector = Rhino.VectorUnitize(arrCurrentVector)
arrResultingVector = Rhino.pointadd(arrResultingVector,arrCurrentVector)
Next
If Rhino.VectorLength(arrResultingVector) = 0 Then
RelaxPt = arrOrigin
Else

arrResultingVector = Rhino.VectorUnitize(arrResultingVector)
arrResultingVector = Rhino.VectorScale(arrResultingVector,dblHowMuch)

Dim arrResultingPt : arrResultingPt = Rhino.PointAdd(arrOrigin,arrResultingVector)
RelaxPt = arrResultingPt

End If
End Function

Function MeshVtxAdjacentVtxs (strMesh, index, blnAbsolutConnections, blnCreate)
' MeshVtxAdjacentVtxs
' finds the adjecent vertices on a mesh for a given index of a vertex.
' written by Ezio Blasetti. Last Revision 071607.
'
' Syntax
' MeshVtxAdjacentVtxs (strMesh, index, blnAbsolutConnections, blnCreate)
'
' Parameters
' strMesh Required. String. The identifier of a mesh object.
' index Required. Integer. The index of a vertex object inside the array returned from Rhino.MeshVertices method.
' Use Rhino.MeshVertexCount for the Ubound of that array.
' blnAbsolutConnections Required. Boolean. If True only the end points of the adjacent edges will be returned.
' Note, if false, all the vertices of the adjacent faces will be returned.
' blnCreate Required. Boolean. Create the adjacent points. If false, points are not created.
'
' Returns
' Array If blnCreate is equal to True , an array containing 3D adjacent points if successful.
' Array If blnCreate is equal to False, an array containing the indexes of the adjacent vetrices if successful.
' Null If not successful, or on error.
'
'
' Example
' dim strObject : strObject = Rhino.GetObject("Select the mesh", 32)
' dim intRndVtxIndex : intRndVtxIndex = 0
' dim arr : arr = MeshVtxAdjacentVtxs (strObject, intRndVtxIndex, VbTrue, VbTrue)
'
'
MeshVtxAdjacentVtxs = Null
If Not Rhino.IsMesh(strMesh) Then Exit Function
If Not IsNumeric(index) Then Exit Function
index=Int(index)

Dim arrVertices : arrVertices = Rhino.MeshVertices (strMesh)
Dim arrFaceVertices : arrFaceVertices = Rhino.MeshFaceVertices(strMesh)
If Not IsArray(arrVertices) Then Exit Function
If Not IsArray(arrFaceVertices) Then Exit Function

Dim intCount : intCount = 0
Dim arrVtxIndex, arrFace, blnIsAdjacent
Dim arrAdjacentVtxs()

For Each arrFace In arrFaceVertices
blnIsAdjacent = VbFalse
For Each arrVtxIndex In arrFace
If arrVtxIndex = index Then
blnIsAdjacent = VbTrue
End If
Next
If blnIsAdjacent Then
If blnAbsolutConnections Then
If arrFace(2)=arrFace(3) Then
For Each arrVtxIndex In arrFace
If Not arrVtxIndex = index Then
ReDim Preserve arrAdjacentVtxs(intCount)
arrAdjacentVtxs(intCount) = arrVtxIndex
intCount = intCount + 1
End If
Next
Else
If index = arrFace(0) Then
ReDim Preserve arrAdjacentVtxs(intCount)
arrAdjacentVtxs(intCount) = arrFace(3)
intCount = intCount + 1
ReDim Preserve arrAdjacentVtxs(intCount)
arrAdjacentVtxs(intCount) = arrFace(1)
intCount = intCount + 1
ElseIf index = arrFace(1) Then
ReDim Preserve arrAdjacentVtxs(intCount)
arrAdjacentVtxs(intCount) = arrFace(0)
intCount = intCount + 1
ReDim Preserve arrAdjacentVtxs(intCount)
arrAdjacentVtxs(intCount) = arrFace(2)
intCount = intCount + 1
ElseIf index = arrFace(2) Then
ReDim Preserve arrAdjacentVtxs(intCount)
arrAdjacentVtxs(intCount) = arrFace(1)
intCount = intCount + 1
ReDim Preserve arrAdjacentVtxs(intCount)
arrAdjacentVtxs(intCount) = arrFace(3)
intCount = intCount + 1
ElseIf index = arrFace(3) Then
ReDim Preserve arrAdjacentVtxs(intCount)
arrAdjacentVtxs(intCount) = arrFace(2)
intCount = intCount + 1
ReDim Preserve arrAdjacentVtxs(intCount)
arrAdjacentVtxs(intCount) = arrFace(0)
intCount = intCount + 1
End If
End If
Else
For Each arrVtxIndex In arrFace
If Not arrVtxIndex = index Then
ReDim Preserve arrAdjacentVtxs(intCount)
arrAdjacentVtxs(intCount) = arrVtxIndex
intCount = intCount + 1
End If
Next
End If
End If
Next

If Not IsArray(arrAdjacentVtxs) Then Exit Function
Dim arrOrderAdjacentVtxs : arrOrderAdjacentVtxs = Rhino.CullDuplicateNumbers (arrAdjacentVtxs)