Excel - Cardinal spline functie (UDF)

Optie 1: Reguliere functies

• Functie CardinalSpline berekent een cardinal spline, gegeven de datapunten (X,Y's). Deze retourneert een string met de spline coördinaten, gescheiden door |.
• Functie extractSubString splitst een string ('zin') in substrings ('woorden'), gegegeven het scheidingsteken. Deze retourneert de n^e substring (vanaf begin of einde). Deze wordt gebruikt om de spline string te splitsen. Deze functie wordt ook gebruikt in voorbeeld 1 van het MS Excel functie referentie bestand.

Optie 2: Matrixfunctie

• Matrixfunctie CardinalSplineArray retourneert een matrix van outputs in plaats van één lange string, en de VBA code laat zien hoe je een gebruikersgedefinieerde matrixfunctie maakt. In Excel geef je een matrixformule in net zoals een gewone formule, maar dan gevolgd door een druk op F2 en vervolgens CTRL+SHIFT+ENTER; er verschijnen dan { } omheen.

     Download demo bestand  (63kB - 603 keer gedownload)



Opmerking

• Een Cardinal Spline kan ook (gecompliceerde) gesloten curves maken: handig bij (industrieel) design. Selecteer 'Spline is closed?' in het download bestand.

MS Excel VBA code te plaatsen in een module

In MS Excel, druk Alt+F11 om de Visual Basic Editor te openen (Windows). Via hoofdmenu: Invoegen → Module. Kopieer onderstaande MS Excel VBA code naar de module.

Public Function CardinalSpline(ByVal dataPoints As Range, ByVal Tension As Single, ByVal isClosed As Boolean, ByVal numSegments As Integer) Dim pts() As Single Dim iRow As Long, i As Long, n As Integer, minusRow As Integer Dim t As Single Dim x As Single Dim Outputs As String 'read data into array and create first and last point based on isClosed value ReDim pts(dataPoints.Rows.Count + 2) For iRow = 1 To dataPoints.Rows.Count pts(iRow) = dataPoints(iRow, 1).Value Next iRow If isClosed Then 'add last point as new first point and add first point as new last point pts(0) = pts(iRow - 1) pts(iRow) = pts(1) pts(iRow + 1) = pts(2) Else 'add first point once more as first point, and last point once more as last point pts(0) = pts(1) pts(iRow) = pts(iRow - 1) pts(iRow + 1) = pts(iRow - 1) End If 'spline calculation If isClosed Then minusRow = 1 Else minusRow = 2 For i = 1 To iRow - minusRow For n = 0 To numSegments - 1 t = n / numSegments x = Tension * (-t ^ 3 + 2 * t ^ 2 - t) * pts(i - 1) + _ Tension * (-t ^ 3 + t ^ 2) * pts(i) + _ (2 * t ^ 3 - 3 * t ^ 2 + 1) * pts(i) + _ Tension * (t ^ 3 - 2 * t ^ 2 + t) * pts(i + 1) + _ (-2 * t ^ 3 + 3 * t ^ 2) * pts(i + 1) + _ Tension * (t ^ 3 - t ^ 2) * pts(i + 2) Outputs = Outputs & Format(x, "0.000000") & "|" Next n Next i Outputs = Outputs & pts(iRow) 'handle potential separator issue If Application.DecimalSeparator = "." Then Outputs = Replace(Outputs, ",", Application.DecimalSeparator) Else Outputs = Replace(Outputs, ".", Application.DecimalSeparator) End If CardinalSpline = Outputs End Function

Public Function extractSubString(ByVal InputString As Range, ByVal separator As String, ByVal n As Integer, Optional ByVal ReadBackwards As Boolean) As Variant Dim x As Variant x = Split(InputString, separator) If n > 0 And n - 1 <= UBound(x) Then If (ReadBackwards = False) Or IsNull(ReadBackwards) Or IsEmpty(ReadBackwards) Then extractSubString = x(n - 1) Else extractSubString = x(UBound(x) - n + 1) End If Else extractSubString = CVErr(xlErrNA) End If End Function

Public Function CardinalSplineArray(ByVal dataPoints As Range, ByVal Tension As Single, ByVal isClosed As Boolean, ByVal numSegments As Integer) As Variant Dim pts() As Single Dim iRow As Long, i As Long, n As Integer, minusRow As Integer Dim t As Single Dim x As Single Dim r As Long 'read data into array and create first and last point based on isClosed value ReDim pts(dataPoints.Rows.Count + 2) For iRow = 1 To dataPoints.Rows.Count pts(iRow) = dataPoints(iRow, 1).Value Next iRow If isClosed Then 'add last point as new first point and add first point twice as new last point pts(0) = pts(iRow - 1) pts(iRow) = pts(1) pts(iRow + 1) = pts(2) Else 'add first point once more as new first point, and last point twice as new last point pts(0) = pts(1) pts(iRow) = pts(iRow - 1) pts(iRow + 1) = pts(iRow - 1) End If 'spline calculation r = 0 If isClosed Then minusRow = 1 Else minusRow = 2 ReDim Outputs(0 To (iRow - minusRow) * numSegments, 0 To 1) As Variant For i = 1 To iRow - minusRow For n = 0 To numSegments - 1 t = n / numSegments x = Tension * (-t ^ 3 + 2 * t ^ 2 - t) * pts(i - 1) + _ Tension * (-t ^ 3 + t ^ 2) * pts(i) + _ (2 * t ^ 3 - 3 * t ^ 2 + 1) * pts(i) + _ Tension * (t ^ 3 - 2 * t ^ 2 + t) * pts(i + 1) + _ (-2 * t ^ 3 + 3 * t ^ 2) * pts(i + 1) + _ Tension * (t ^ 3 - t ^ 2) * pts(i + 2) Outputs(r, 0) = x r = r + 1 Next n Next i Outputs(r, 0) = pts(iRow) CardinalSplineArray = Outputs End Function