# Is there a projection to draw north point and south point of a sphere like this and keep form of all circles on sphere?

I see this picture

and draw this picture by 3dtools

If I tried put two points $$N$$ and $$S$$ like the first picture, I get one cicrle

Is there a projection to draw north point and south point of sphere like this here and keep form of all circles on sphere

• It is correct it is just from other view point. Nov 15, 2023 at 15:39
• You can use different view point Graphics3D[{Sphere[{0, 0, 0}], PointSize[Large], Red, Point[{0, 0, 1}]}, Boxed -> False, ViewPoint -> {0, -1, 0}]. Nov 15, 2023 at 15:43
• If you use Show[g1, rall, ViewPoint -> {0, -1, 0}] for Syed's code, you get one a circle. Nov 16, 2023 at 5:59

Parameters

angles = {-Pi/2, Pi/2};

{r1, r2}  = {1/4, 1/8};

displacement = -Pi/6;


Coordinates

l1 = Threaded[{r1, 1}] Transpose @ Through @ {Cos, Sin} @ (angles + Pi);
l2 = Threaded[{1, r2}] Transpose @ Through @
{Cos, Sin} @ (angles + displacement);

pointcoords = Join[{{0, 0}}, l1, l2];


Lines, Points

points = Point /@ pointcoords;

dashedlines = Line /@ {l1, l2};


Labels

labels = Style[#, 16] & /@ {"O", "N", "S", "A", "B"};

offsets = {{1, -1}, {0, -3/2}, {0, 2}, {1, 3/2}, {-2, 3/2}};

texts = MapThread[Text] @ {labels, pointcoords, offsets};


Circle segments

trnsfrm = Circle[#, {1/r1, r2} #2, #3 + Pi/2] & @@ # &;

c1 = Circle[{0, 0}, {r1, 1}, angles];

dashedcirclesegments = {c1, trnsfrm @ c1};

solidcirclesegments = {#, trnsfrm @ #} & @ MapAt[# + Pi &, c1, {3}];


All inside Graphics

Graphics[{PointSize @ Large, points, texts,
Circle[], solidcirclesegments,
Dashed, dashedcirclesegments, dashedlines}]


picture at the top

Replace displacement = -Pi/6 with displacement = -Pi/12 to get

Clear["Global*"];

s1 = Sphere[];
ux = UnitVector[3, 1];
uy = UnitVector[3, 2];
uz = UnitVector[3, 3];
orig = {0, 0, 0};
r1 = RegionIntersection[s1, Hyperplane[ux, 0]];
r2 = RegionIntersection[s1, Hyperplane[uy, 0]];
r3 = RegionIntersection[s1, Hyperplane[uz, 0]];
xaxis = InfiniteLine[orig, ux];
yaxis = InfiniteLine[orig, uy];
zaxis = InfiniteLine[orig, uz];

rall = Region[#, Lighting -> {"Ambient", White}] & /@ {
Style[s1, Opacity[0.05, Green]]
, Style[r1, {Thin, Black}]
, Style[r2, {Thin, Black}]
, Style[r3, {Thin, Black}]
};

g1 = Graphics3D[{
{Dashed, xaxis, yaxis, zaxis}
, Black, AbsolutePointSize[8]
, Point@{orig, {0, 0, 1}, {1, 0, 0}, {-1, 0, 0}, {0, 0, 1}, {0,
0, -1}}
, Text[
Style["O", Bold, Italic, FontFamily -> "Times",
16], {0, 0, 0} + {0.1, 0, 0.1}]
, Text[
Style["A", Bold, Italic, FontFamily -> "Times",
16], {1, 0, 0} + {0.1, 0, 0.1}]
, Text[
Style["B", Bold, Italic, FontFamily -> "Times",
16], {-1, 0, 0} + {-0.1, 0, 0.1}]
, Text[
Style["N", Bold, Italic, FontFamily -> "Times",
16], {0, 0, 1} + {0, 0.1, 0.1}]
, Text[
Style["S", Bold, Italic, FontFamily -> "Times",
16], {0, 0, -1} + {0, 0.1, -0.1}]
}
, Boxed -> False
, Lighting -> {"Ambient", White}
];

Show[g1, rall]


• I tried your code with Show[g1, rall, ViewPoint -> {0, -1, 0}], I get one circle. It seems difficult for the view like this mathworld.wolfram.com/NorthPole.html Nov 16, 2023 at 5:15
• This is how 3D works. Please wait, and someone can perhaps write a better answer.
– Syed
Nov 16, 2023 at 5:19

Here is an example to get you started with the various options. It all depends on how much fidelity you want to those other pictures. You might even want to use 2D graphics and do your own projections.

Graphics3D[
{{Opacity[.2], Sphere[{0, 0, 0}]},
{Dashing[.04], Thick, Line[Append[0] /@ CirclePoints[100]]},
{PointSize[Scaled[.05]], Red, Point[{0, 0, 1}], Point[{0, 0, -1}]}},
Boxed -> False,
ViewPoint -> {0, -1, .1},
ViewProjection -> "Orthographic"]
`