Skip to main content
replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/
Source Link

N.B. The previous version of this answer featured BSplineSurface[] objects with noticeable blemishes; this turned out to be due to insufficient internal sampling. Adding the option BaseStyle -> {BSplineSurface3DBoxOptions -> {Method -> {"SplinePoints" -> 40}}} (similar to what Mr. Wizard did herehere) minimizes the blemishes to a barely noticeable spot.

N.B. The previous version of this answer featured BSplineSurface[] objects with noticeable blemishes; this turned out to be due to insufficient internal sampling. Adding the option BaseStyle -> {BSplineSurface3DBoxOptions -> {Method -> {"SplinePoints" -> 40}}} (similar to what Mr. Wizard did here) minimizes the blemishes to a barely noticeable spot.

N.B. The previous version of this answer featured BSplineSurface[] objects with noticeable blemishes; this turned out to be due to insufficient internal sampling. Adding the option BaseStyle -> {BSplineSurface3DBoxOptions -> {Method -> {"SplinePoints" -> 40}}} (similar to what Mr. Wizard did here) minimizes the blemishes to a barely noticeable spot.

added 657 characters in body
Source Link
With[{r = 1}, 
     Graphics3D[{EdgeForm[],
                 BSplineSurface[Outer[Append[First[#1] #2, Last[#1]] &, 
                       r {{0, 1}, {1, 1}, {1, 0}},
                       {{1, 0}, {1, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {1, -1}, {1, 0}}, 1], 
                                SplineClosed -> {False, True}, SplineDegree -> 2, 
                                SplineKnots -> {{0, 0, 0, 1, 1, 1},
                                                {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1}}, 
                                SplineWeights -> Outer[Times, {1, 1/Sqrt[2], 1},
                                                       {1, 1/2, 1/2, 1, 1/2, 1/2, 1}]]},
                BaseStyle -> {BSplineSurface3DBoxOptions ->
                              {Method -> {"SplinePoints" -> 40}}}, Boxed -> False]]

another hemisphereanother hemisphere

With[{r = 1}, 
     Graphics3D[{EdgeForm[], 
                 BSplineSurface[Outer[Insert[First[#1] #2, Last[#1], 2] &, 
                                      r {{0, -1}, {1, -1}, {1, 1}, {0, 1}},
                                      {{-1, 0}, {-1, 1}, {1, 1}, {1, 0}}, 1],
                                SplineDegree -> 2, 
                                SplineKnots -> {{0, 0, 0, 1/2, 1, 1, 1},
                                                {0, 0, 0, 1/2, 1, 1, 1}},
                                SplineWeights -> Outer[Times, {1, 1/2, 1/2, 1},
                                                              {1, 1/2, 1/2, 1}]]}, 
                BaseStyle -> {BSplineSurface3DBoxOptions ->
                              {Method -> {"SplinePoints" -> 40}}}, Boxed -> False]]

another hemispherestill another hemisphere

N.B. The previous version of this answer featured BSplineSurface[] objects with noticeable blemishes; this turned out to be due to insufficient internal sampling. Adding the option BaseStyle -> {BSplineSurface3DBoxOptions -> {Method -> {"SplinePoints" -> 40}}} (similar to what Mr. Wizard did here) minimizes the blemishes to a barely noticeable spot.

With[{r = 1}, 
     Graphics3D[{EdgeForm[],
                 BSplineSurface[Outer[Append[First[#1] #2, Last[#1]] &, 
                       r {{0, 1}, {1, 1}, {1, 0}},
                       {{1, 0}, {1, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {1, -1}, {1, 0}}, 1], 
                                SplineClosed -> {False, True}, SplineDegree -> 2, 
                                SplineKnots -> {{0, 0, 0, 1, 1, 1},
                                                {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1}}, 
                                SplineWeights -> Outer[Times, {1, 1/Sqrt[2], 1},
                                                       {1, 1/2, 1/2, 1, 1/2, 1/2, 1}]]},
                Boxed -> False]]

another hemisphere

With[{r = 1}, 
     Graphics3D[{EdgeForm[], 
                 BSplineSurface[Outer[Insert[First[#1] #2, Last[#1], 2] &, 
                                      r {{0, -1}, {1, -1}, {1, 1}, {0, 1}},
                                      {{-1, 0}, {-1, 1}, {1, 1}, {1, 0}}, 1],
                                SplineDegree -> 2, 
                                SplineKnots -> {{0, 0, 0, 1/2, 1, 1, 1},
                                                {0, 0, 0, 1/2, 1, 1, 1}},
                                SplineWeights -> Outer[Times, {1, 1/2, 1/2, 1},
                                                              {1, 1/2, 1/2, 1}]]}, 
                Boxed -> False]]

another hemisphere

With[{r = 1}, 
     Graphics3D[{EdgeForm[],
                 BSplineSurface[Outer[Append[First[#1] #2, Last[#1]] &, 
                       r {{0, 1}, {1, 1}, {1, 0}},
                       {{1, 0}, {1, 1}, {-1, 1}, {-1, 0}, {-1, -1}, {1, -1}, {1, 0}}, 1], 
                                SplineClosed -> {False, True}, SplineDegree -> 2, 
                                SplineKnots -> {{0, 0, 0, 1, 1, 1},
                                                {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1}}, 
                                SplineWeights -> Outer[Times, {1, 1/Sqrt[2], 1},
                                                       {1, 1/2, 1/2, 1, 1/2, 1/2, 1}]]},
                BaseStyle -> {BSplineSurface3DBoxOptions ->
                              {Method -> {"SplinePoints" -> 40}}}, Boxed -> False]]

another hemisphere

With[{r = 1}, 
     Graphics3D[{EdgeForm[], 
                 BSplineSurface[Outer[Insert[First[#1] #2, Last[#1], 2] &, 
                                      r {{0, -1}, {1, -1}, {1, 1}, {0, 1}},
                                      {{-1, 0}, {-1, 1}, {1, 1}, {1, 0}}, 1],
                                SplineDegree -> 2, 
                                SplineKnots -> {{0, 0, 0, 1/2, 1, 1, 1},
                                                {0, 0, 0, 1/2, 1, 1, 1}},
                                SplineWeights -> Outer[Times, {1, 1/2, 1/2, 1},
                                                              {1, 1/2, 1/2, 1}]]}, 
                BaseStyle -> {BSplineSurface3DBoxOptions ->
                              {Method -> {"SplinePoints" -> 40}}}, Boxed -> False]]

still another hemisphere

N.B. The previous version of this answer featured BSplineSurface[] objects with noticeable blemishes; this turned out to be due to insufficient internal sampling. Adding the option BaseStyle -> {BSplineSurface3DBoxOptions -> {Method -> {"SplinePoints" -> 40}}} (similar to what Mr. Wizard did here) minimizes the blemishes to a barely noticeable spot.

added 850 characters in body
Source Link

Here's another NURBS representation of a hemisphere:

With[{r = 1}, 
     Graphics3D[{EdgeForm[], 
                 BSplineSurface[Outer[Insert[First[#1] #2, Last[#1], 2] &, 
                                      r {{0, -1}, {1, -1}, {1, 1}, {0, 1}},
                                      {{-1, 0}, {-1, 1}, {1, 1}, {1, 0}}, 1],
                                SplineDegree -> 2, 
                                SplineKnots -> {{0, 0, 0, 1/2, 1, 1, 1},
                                                {0, 0, 0, 1/2, 1, 1, 1}},
                                SplineWeights -> Outer[Times, {1, 1/2, 1/2, 1},
                                                              {1, 1/2, 1/2, 1}]]}, 
                Boxed -> False]]

another hemisphere


Here's another NURBS representation of a hemisphere:

With[{r = 1}, 
     Graphics3D[{EdgeForm[], 
                 BSplineSurface[Outer[Insert[First[#1] #2, Last[#1], 2] &, 
                                      r {{0, -1}, {1, -1}, {1, 1}, {0, 1}},
                                      {{-1, 0}, {-1, 1}, {1, 1}, {1, 0}}, 1],
                                SplineDegree -> 2, 
                                SplineKnots -> {{0, 0, 0, 1/2, 1, 1, 1},
                                                {0, 0, 0, 1/2, 1, 1, 1}},
                                SplineWeights -> Outer[Times, {1, 1/2, 1/2, 1},
                                                              {1, 1/2, 1/2, 1}]]}, 
                Boxed -> False]]

another hemisphere

Source Link
Loading