1
$\begingroup$

This question already has an answer here:

I have a piece of code that generates a circle on a sphere, but the problem is, this code creates only one circle. How can I change it in order to create n circles on the same sphere? Do I have to put the code in a loop?

    Needs["Combinatorica`"];
greatCircle[\[CurlyPhi]_, \[Theta]_, r_: 1] := 
 BSplineCurve[
  Composition[RotationTransform[\[Theta], {0, 0, 1}], 
    RotationTransform[-\[CurlyPhi], {0, 1, 
      0}]] /@ (r {{1, 0, 0}, {1, 1, 0}, {-1, 1, 0}, {-1, 0, 
       0}, {-1, -1, 0}, {1, -1, 0}, {1, 0, 0}}), SplineDegree -> 2, 
  SplineKnots -> {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1}, 
  SplineWeights -> {1, 1/2, 1/2, 1, 1/2, 1/2, 1}]
With[{\[CurlyEpsilon] = 
   1*^-3 (*shrinks sphere slightly*), \[CurlyPhi] = 
   30 \[Degree] (*inclination*)}, 
 Graphics3D[{{Opacity[2/5, Blue], 
    Sphere[{0, 0, 0}, 1 - \[CurlyEpsilon]]}, {Directive[
     AbsoluteThickness[3], Red], greatCircle[\[CurlyPhi], 0]}}, 
  Lighting -> "Neutral"]]

Mathematica graphics

$\endgroup$

marked as duplicate by Dr. belisarius, Community Oct 23 '15 at 23:43

This question has been asked before and already has an answer. If those answers do not fully address your question, please ask a new question.

  • 1
    $\begingroup$ mathematica.stackexchange.com/questions/16413/… $\endgroup$ – David G. Stork Oct 23 '15 at 23:23
  • $\begingroup$ I was going to put this in an answer, where it would have been a lot more readable, but the question got closed me. So this will have to do. With[{ε = 1*^-3, φ = 45 °, n = 5}, Module[{step = 360 °/n}, Graphics3D[{{Opacity[2/5, Blue], Sphere[{0, 0, 0}, 1 - ε]}, {AbsoluteThickness[3], Red, Table[greatCircle[φ, θ], {θ, (Range[n] - 1) step}]}}, Lighting -> "Neutral"]]] Of course you could make the table vary over φ rather than θ. $\endgroup$ – m_goldberg Oct 24 '15 at 0:14
  • $\begingroup$ oh my God, it worked!. I it is exactly what I am looking for. Thank you so much! $\endgroup$ – user35019 Oct 24 '15 at 0:42
  • $\begingroup$ The function doesn't look too hard to use: Graphics3D[{greatCircle[0, 0], greatCircle[π/2, 0]}]. $\endgroup$ – J. M. will be back soon Oct 24 '15 at 0:57