2
$\begingroup$

With BSplineSurface, I was trying to interpolate data points belonging to a sphere, but unfortunately I don't get the right geometry closing:

r = 1;
step = 30 π /180 ;
pts = Table[
            r {Cos[Θ] Cos[Ψ], 
               Cos[Θ] Sin[Ψ], 
               Sin[Θ]},
            {Θ, 0, 2 π, step}, 
            {Ψ,   0,  π, step}
];
Graphics3D[{BSplineSurface[pts, SplineClosed -> {True, True}],
            Red, Point[#] & /@ pts}
]

my attempt

How can one get the right Spline-closing to get a sphere out of the interpolation?

$\endgroup$
  • 1
    $\begingroup$ So, what are your desiderata for your spline surface. As is, the question is way to broad. Btw.: "Nice" spline interpolation for surfaces with a topology different from a reactangle, cylinder, or torus are rather nontrivial. $\endgroup$ – Henrik Schumacher Jul 9 '18 at 15:51
  • $\begingroup$ I restrict myself to the sphere interpolation then first. Is it possible to get the "right" closing of the BSpline Surface to reproduce the sphere geometry? $\endgroup$ – N.Schl Jul 9 '18 at 17:03
  • 1
    $\begingroup$ Well, you get something that almost looks like a sphere with r = 1; step = 10 Pi/180; pts = Most@ Table[r {Cos[\[CapitalTheta]] Cos[\[CapitalPsi]], Cos[\[CapitalTheta]] Sin[\[CapitalPsi]], Sin[\[CapitalTheta]]}, {\[CapitalPsi], -Pi, Pi, step}, {\[CapitalTheta], -Pi/2, Pi/2, step}]; Graphics3D[{BSplineSurface[pts, SplineClosed -> {True, False}], Red, Point[#] & /@ pts}]. $\endgroup$ – Henrik Schumacher Jul 9 '18 at 17:49
4
$\begingroup$

In fact, a sphere has a very simple NURBS representation. It can be easily built up from the NURBS circle of Piegl and Tiller. A Mathematica implementation goes like this:

mySphere[center : (_?VectorQ) : {0, 0, 0}, radius : _?NumericQ : 1] :=
  Block[{ctrlpts},
        ctrlpts = Composition[TranslationTransform[center],
                              ScalingTransform[ConstantArray[radius, 3]]] /@ 
        Outer[Append[#2 #1[[1]], #1[[2]]] &,
              {{0, -1}, {1, -1}, {1, 1}, {0, 1}},
              {{1, 0}, {1, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {1, -1}, {1, 0}}, 1];
        BSplineSurface[ctrlpts, SplineClosed -> True, SplineDegree -> 2, 
                       SplineKnots -> {{0, 0, 0, 1/2, 1, 1, 1},
                                       {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1}}, 
                       SplineWeights -> Outer[Times, {1, 1/2, 1/2, 1},
                                              {1, 1/2, 1/2, 1, 1/2, 1/2, 1}]]]

For example:

Graphics3D[mySphere[], Boxed -> False]

NURBS sphere

(I had used this here for generating ellipsoids.)

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.