Spline in VB

Top  Previous  Next

                       Attribute VB_Name = "Module1"

Option Explicit

 

Public Type VBTocka

 

X As Double

Y As Double

 

End Type

 

Public Type vbgledisce

 

X As Double

Y As Double

z As Double

d As Double

 

End Type

 

Public Type vb3dtocka

 

X As Double

Y As Double

z As Double

 

End Type

 

Public gledisce As vbgledisce

 

Public Type VBBezier3d

 

kontrolne() As vb3dtocka

risi() As vb3dtocka

 

nx As Integer ' no. of control points

ny As Integer

 

nbx As Integer ' no. of final points between control points

nby As Integer

 

End Type

 

Public Type VBBezier

 

kontrolne() As VBTocka

risi() As VBTocka

 

n As Integer ' no. of control pts

nb As Integer

 

End Type

Public Function bezier(tmp As VBBezier)

 

Dim t As Double

Dim i As Integer

Dim j As Integer

ReDim tmp.risi(tmp.nb)

 

For i = 1 To tmp.nb

 

  t = (i - 1) / (tmp.nb - 1)

  tmp.risi(i).X = 0

  tmp.risi(i).Y = 0

 

  For j = 0 To tmp.n - 1

      tmp.risi(i).X = tmp.risi(i).X + ncr(tmp.n - 1, j) * ((1 - t) ^ (tmp.n - j - 1)) * (t ^ j) * tmp.kontrolne(j + 1).X

      tmp.risi(i).Y = tmp.risi(i).Y + ncr(tmp.n - 1, j) * ((1 - t) ^ (tmp.n - j - 1)) * (t ^ j) * tmp.kontrolne(j + 1).Y

  ' + z

  Next j

 

Next i

 

End Function

Private Function ncr(n As Integer, j As Integer) As Double

Dim i As Integer

 

  ncr = 1

  If (n = 0) Or (j = 0) Or (n = j) Then Exit Function

  For i = 1 To n - j

      ncr = ncr * (1 + j / i)

  Next i

End Function

Public Function bspline(tmp As VBBezier, k As Integer)

 

Dim t As Double

Dim i As Integer

Dim j As Integer

Dim bn() As Double

ReDim tmp.risi(tmp.nb)

ReDim bn(0 To tmp.n)

 

For i = 1 To tmp.nb

 

  t = (i - 1) / (tmp.nb - 1) * (tmp.n - k + 1)

  tmp.risi(i).X = 0

  tmp.risi(i).Y = 0

 

  ' Call b_point(x, y, n, xb(i), yb(i), t, k)

 

  If t - (tmp.n - 1) + k - 2 = 0 Then

      tmp.risi(i).X = tmp.kontrolne(tmp.n).X

      tmp.risi(i).Y = tmp.kontrolne(tmp.n).Y

  Else

      Call bspline_calc((tmp.n - 1), t, k, bn)

      tmp.risi(i).X = 0

      tmp.risi(i).Y = 0

      For j = 0 To tmp.n - 1

          tmp.risi(i).X = tmp.risi(i).X + bn(j) * tmp.kontrolne(j + 1).X

          tmp.risi(i).Y = tmp.risi(i).Y + bn(j) * tmp.kontrolne(j + 1).Y

      Next j

  End If

 

Next i

 

End Function

Private Function bspline_calc(n As Integer, u As Double, k As Integer, bn() As Double)

 

Dim nt As Double

Dim i As Double

Dim j As Double

Dim bu0 As Double

Dim bl0 As Double

Dim bu1 As Double

Dim bl1 As Double

Dim b0 As Double

Dim b1 As Double

Dim bn0() As Double

Dim t() As Double

 

 

 

ReDim bn0(0 To n + 1)

ReDim t(0 To n + k + 1)

 

  nt = n + k + 1

  For i = 0 To nt

      If (i < k) Then t(i) = 0

      If (i >= k) And (i <= n) Then t(i) = i - k + 1

      If (i > n) Then t(i) = n - k + 2

  Next i

 

  For i = 0 To n

      bn0(i) = 0

      If (u >= t(i)) And (u < t(i + 1)) Then bn0(i) = 1

      If (t(i) = 0) And (t(i + 1) = 0) Then bn0(i) = 0

  Next i

 

  For j = 2 To k

      For i = 0 To n

          bu0 = (u - (t(i))) * bn0(i)

          bl0 = t(i + j - 1) - t(i)

          If (bl0 = 0) Then

              b0 = 0

          Else

              b0 = CDbl(bu0) / bl0

          End If

 

          bu1 = (t(i + j) - u) * bn0(i + 1)

          bl1 = t(i + j) - t(i + 1)

 

          If (bl1 = 0) Then

              b1 = 0

          Else

              b1 = CDbl(bu1) / bl1

          End If

 

          bn(i) = b0 + b1

      Next i

 

      For i = 0 To n

          bn0(i) = bn(i)

      Next i

  Next j

 

 

End Function

Public Function beziersurface(tmp As VBBezier3d)

 

Dim tx As Double

Dim ty As Double

Dim vmesna As Double

 

Dim i As Integer

Dim j As Integer

Dim k As Integer

Dim l As Integer

 

ReDim tmp.risi(tmp.nbx, tmp.nby)

 

For l = 1 To tmp.nby

 

  ty = (l - 1) / (tmp.nby - 1)

 

      For i = 1 To tmp.nbx

 

      tx = (i - 1) / (tmp.nbx - 1)

 

      tmp.risi(i, l).X = 0

      tmp.risi(i, l).Y = 0

      tmp.risi(i, l).z = 0

 

      For j = 0 To tmp.nx - 1

          For k = 0 To tmp.ny - 1

 

              vmesna = (ncr(tmp.nx - 1, j) * ((1 - tx) ^ (tmp.nx - j - 1)) * (tx ^ j)) * (ncr(tmp.ny - 1, k) * ((1 - ty) ^ (tmp.ny - k - 1)) * (ty ^ k))

              tmp.risi(i, l).X = tmp.risi(i, l).X + vmesna * tmp.kontrolne(j + 1, k + 1).X

              tmp.risi(i, l).Y = tmp.risi(i, l).Y + vmesna * tmp.kontrolne(j + 1, k + 1).Y

              tmp.risi(i, l).z = tmp.risi(i, l).z + vmesna * tmp.kontrolne(j + 1, k + 1).z

 

          Next k

      Next j

 

  Next i

 

Next l

End Function

Public Function vrti2d3d(stare() As VBTocka, novo As VBBezier3d)

Dim i As Integer

Dim j As Integer

Dim tmp As VBTocka

Dim tmp2 As vb3dtocka

 

ReDim novo.kontrolne(novo.nx, novo.ny)

 

For i = 1 To novo.ny

  For j = 1 To novo.nx

 

      tmp = stare(j)

      tmp2.z = tmp.Y / 20

      tmp2.X = tmp.X * Cos(2 * 3.14 * i / (novo.ny - 1))

      tmp2.Y = tmp.X * Sin(2 * 3.14 * i / (novo.ny - 1))

 

      novo.kontrolne(j, i) = tmp2

  Next j

Next i

 

End Function

Function cnvto2d(tmp As vb3dtocka) As VBTocka

 

  cnvto2d.X = (tmp.X - gledisce.X) / (1 - (tmp.z - gledisce.z) / gledisce.d)

  cnvto2d.Y = (tmp.Y - gledisce.Y) / (1 - (tmp.z - gledisce.z) / gledisce.d)

 

End Function

Function Transliraj(tmp As VBBezier3d, t As vb3dtocka)

Dim i As Integer

Dim j As Integer

 

For i = 1 To tmp.ny

  For j = 1 To tmp.nx

      tmp.kontrolne(j, i).X = tmp.kontrolne(j, i).X + t.X

      tmp.kontrolne(j, i).Y = tmp.kontrolne(j, i).Y + t.Y

      tmp.kontrolne(j, i).z = tmp.kontrolne(j, i).z + t.z

  Next j

Next i

 

End Function

Function Rotiraj(tmp As VBBezier3d, r As vb3dtocka)

 

Dim i As Integer

Dim j As Integer

Dim k As Double

 

Dim t1 As vb3dtocka

Dim t2 As vb3dtocka

 

Dim pi As Double

pi = 3.14

 

For i = 1 To tmp.ny

  For j = 1 To tmp.nx

 

      t1.X = tmp.kontrolne(j, i).X

      t1.Y = tmp.kontrolne(j, i).Y

      t1.z = tmp.kontrolne(j, i).z

 

      k = (r.X * pi) / 180

      t2.X = t1.X

      t2.Y = t1.Y * Cos(k) - t1.z * Sin(k)

      t2.z = t1.Y * Sin(k) + t1.z * Cos(k)

 

      k = (r.Y * pi) / 180

      t1.X = t2.X * Cos(k) + t2.z * Sin(k)

      t1.Y = t2.Y

      t1.z = t2.z * Cos(k) - t2.X * Sin(k)

 

      k = (r.z * pi) / 180

      t2.X = t1.X * Cos(k) - t1.Y * Sin(k)

      t2.Y = t1.X * Sin(k) + t1.Y * Cos(k)

      t2.z = t1.z

 

      tmp.kontrolne(j, i).X = t2.X

      tmp.kontrolne(j, i).Y = t2.Y

      tmp.kontrolne(j, i).z = t2.z

  Next j

Next i

 

End Function

Function skaliraj(tmp As VBBezier3d, s As vb3dtocka)

 

Dim i As Integer

Dim j As Integer

 

For i = 1 To tmp.ny

  For j = 1 To tmp.nx

      tmp.kontrolne(j, i).X = tmp.kontrolne(j, i).X * s.X

      tmp.kontrolne(j, i).Y = tmp.kontrolne(j, i).Y * s.Y

      tmp.kontrolne(j, i).z = tmp.kontrolne(j, i).z * s.z

  Next j

Next i

 

End Function

Function Rotiraj_risi(tmp As VBBezier3d, r As vb3dtocka)

Dim i As Integer

Dim j As Integer

Dim k As Double

 

Dim t1 As vb3dtocka

Dim t2 As vb3dtocka

 

Dim pi As Double

pi = 3.14

 

For i = 1 To tmp.nby

  For j = 1 To tmp.nbx

 

      t1.X = tmp.risi(j, i).X

      t1.Y = tmp.risi(j, i).Y

      t1.z = tmp.risi(j, i).z

 

      k = (r.X * pi) / 180

      t2.X = t1.X

      t2.Y = t1.Y * Cos(k) - t1.z * Sin(k)

      t2.z = t1.Y * Sin(k) + t1.z * Cos(k)

 

      k = (r.Y * pi) / 180

      t1.X = t2.X * Cos(k) + t2.z * Sin(k)

      t1.Y = t2.Y

      t1.z = t2.z * Cos(k) - t2.X * Sin(k)

 

      k = (r.z * pi) / 180

      t2.X = t1.X * Cos(k) - t1.Y * Sin(k)

      t2.Y = t1.X * Sin(k) + t1.Y * Cos(k)

      t2.z = t1.z

 

      tmp.risi(j, i).X = t2.X

      tmp.risi(j, i).Y = t2.Y

      tmp.risi(j, i).z = t2.z

  Next j

Next i

End Function

Public Function bsplinesurface(tmp As VBBezier3d, kx As Integer, ky As Integer)

 

Dim tx As Double

Dim ty As Double

Dim i As Integer

Dim j As Integer

Dim m As Integer

Dim l As Integer

Dim bnx() As Double

Dim bny() As Double

ReDim tmp.risi(tmp.nbx, tmp.nby)

ReDim bnx(tmp.nx)

ReDim bny(tmp.ny)

 

For l = 1 To tmp.nby

 

  ty = (l - 1) / (tmp.nby - 1) * (tmp.ny - ky + 1)

 

  For i = 1 To tmp.nbx

 

      tx = (i - 1) / (tmp.nbx - 1) * (tmp.nx - kx + 1)

 

      tmp.risi(i, l).X = 0

      tmp.risi(i, l).Y = 0

      tmp.risi(i, l).z = 0

 

      If tx - (tmp.nx - 1) + kx - 2 = 0 And ty - (tmp.ny - 1) + ky - 2 = 0 Then

          tmp.risi(i, l).X = tmp.kontrolne(tmp.nx, tmp.ny).X

          tmp.risi(i, l).Y = tmp.kontrolne(tmp.nx, tmp.ny).Y

          tmp.risi(i, l).z = tmp.kontrolne(tmp.nx, tmp.ny).z

 

      Else

 

          Call bspline_calc((tmp.nx - 1), tx, kx, bnx)

          Call bspline_calc((tmp.ny - 1), ty, ky, bny)

 

          tmp.risi(i, l).X = 0

          tmp.risi(i, l).Y = 0

          tmp.risi(i, l).z = 0

 

          For j = 0 To tmp.nx - 1

              For m = 0 To tmp.ny - 1

 

                      tmp.risi(i, l).X = tmp.risi(i, l).X + bnx(j) * bny(m) * tmp.kontrolne(j + 1, m + 1).X

                      tmp.risi(i, l).Y = tmp.risi(i, l).Y + bnx(j) * bny(m) * tmp.kontrolne(j + 1, m + 1).Y

                      tmp.risi(i, l).z = tmp.risi(i, l).z + bnx(j) * bny(m) * tmp.kontrolne(j + 1, m + 1).z

 

              Next m

          Next j

      End If

 

  Next i

Next l

 

End Function

Function Transliraj_risi(tmp As VBBezier3d, t As vb3dtocka)

Dim i As Integer

Dim j As Integer

 

For i = 1 To tmp.nby

  For j = 1 To tmp.nbx

      tmp.risi(j, i).X = tmp.risi(j, i).X + t.X

      tmp.risi(j, i).Y = tmp.risi(j, i).Y + t.Y

      tmp.risi(j, i).z = tmp.risi(j, i).z + t.z

  Next j

Next i

 

End Function

Function transliraj_gledisce(X As Double, Y As Double, z As Double, x1 As Double, y1 As Double, z1 As Double)

 

X = X + x1

Y = Y + y1

z = z + z1

 

End Function

Function rotiraj_gledisce(X As Double, Y As Double, z As Double, kx As Double, ky As Double, kz As Double)

Dim k As Double

Dim pi As Double

pi = 3.14

 

Dim x1 As Double

Dim y1 As Double

Dim z1 As Double

 

      k = (kx * pi) / 180

      x1 = X

      y1 = Y * Cos(k) - z * Sin(k)

      z1 = Y * Sin(k) + z * Cos(k)

 

      k = (ky * pi) / 180

      X = x1 * Cos(k) + z1 * Sin(k)

      Y = y1

      z = z1 * Cos(k) - x1 * Sin(k)

 

      k = (kz * pi) / 180

      x1 = X * Cos(k) - Y * Sin(k)

      y1 = X * Sin(k) + Y * Cos(k)

      z1 = z

 

      X = x1

      Y = y1

      z = z1

 

End Function

Function skaliraj_gledisce(X As Double, Y As Double, z As Double, sx As Double, sy As Double, sz As Double)

 

      X = X * sx

      Y = Y * sy

      z = z * sz

 

End Function

Function skaliraj_risi(tmp As VBBezier3d, s As vb3dtocka)

 

Dim i As Integer

Dim j As Integer

 

For i = 1 To tmp.nby

  For j = 1 To tmp.nbx

      tmp.risi(j, i).X = tmp.risi(j, i).X * s.X

      tmp.risi(j, i).Y = tmp.risi(j, i).Y * s.Y

      tmp.risi(j, i).z = tmp.risi(j, i).z * s.z

  Next j

Next i

 

End Function