# How to draw two circles on sphere?

I am trying to draw two circle SAB and ABC on this sphere (no need dashed line)

I tried

a = {0, 0, 0};
b = {7, 0, 0};
c = {65/14, (15 Sqrt[3])/14, 0};
s = {52/7, 0, (12 Sqrt[3])/7};
Graphics3D[{Opacity[.25], Circumsphere[{a, b, c, s}]}, Boxed -> False]


## 3 Answers

Circumsphere correctly gave you the sphere that passes through points $$A, B, C, S$$. To get the circumscribed circles, I suggest using a WFR function Circumcircle3D.

a = {0, 0, 0};
b = {7, 0, 0};
c = {65/14, (15 Sqrt[3])/14, 0};
s = {52/7, 0, (12 Sqrt[3])/7};

(* Generate point labels and markers *)
pts = {{Red, Point[#[[2]]]}, {Text[#[[1]], #[[2]] + {0, 0, .5}]}} & /@
Transpose[{{"A", "B", "C", "S"}, {a, b, c, s}}];

circumcircle = ResourceFunction["Circumcircle3D"];

Graphics3D[{circumcircle[{a, b, c}], circumcircle[{a, b, s}],
PointSize[.02], pts, Opacity[.2], Circumsphere[{a, b, c, s}]},
Boxed -> False]


For the input in OP, we can also use RegionPlot3D with the options MeshFunctions and Mesh:

cs = Circumsphere[{a, b, c, s}];

Show[RegionPlot3D[cs,
PlotStyle -> Opacity[.1, LightBlue],
MeshFunctions -> {#2 &, #3 &},
Mesh -> {{{0, Directive[Orange, Thick, Opacity[1]]}},
{{0, Directive[Blue, Thick, Opacity[1]]}}}],
Graphics3D[MapThread[{Black, PointSize[Large], Point@#2, Text[##, {1, -1}]} &,
{{"A", "B", "C", "S"}, {a, b, c, s}}]]]


Alternatively, we can get the two circles using RegionIntersection[cs, InfinitePlane[{a, b, c}] and RegionIntersection[cs, InfinitePlane[{a, b, s}]:

{c1, c2} = MeshPrimitives[DiscretizeRegion @
RegionIntersection[cs, InfinitePlane[{a, b, #}]], 1] & /@ {c, s};

Graphics3D[{Opacity[.25], cs,
Opacity[1], Thick, Blue, c1, Orange, c2,
Black, PointSize[Large], Point @ {a, b, c, s},
MapThread[Text[##, {1, -1}] &, {{"A", "B", "C", "S"}, {a, b, c, s}}]}]


To draw the dashed line automatic, we use the method come from https://mathematica.stackexchange.com/a/238191/72111

a = {0, 0, 0};
b = {7, 0, 0};
c = {65/14, (15 Sqrt[3])/14, 0};
s = {52/7, 0, (12 Sqrt[3])/7};
ball = Circumsphere[{a, b, c, s}];
center = RegionCentroid[ball];
reg1 = RegionIntersection[InfinitePlane[{s, a, b}],
Circumsphere[{a, b, c, s}]];
reg2 = RegionIntersection[InfinitePlane[{a, b, c}],
Circumsphere[{a, b, c, s}]];
DynamicModule[{v = {2, 1.60, 1.23}},
Graphics3D[{{{{Opacity[.1],
ball}, {ClipPlanes -> Dynamic@Append[v, -v . center], Red,
Thick, HighlightMesh[
DiscretizeRegion[reg1], {Style[0, None],
Style[1, Directive[AbsoluteThickness[2], Red]]}],
HighlightMesh[
DiscretizeRegion[reg2], {Style[0, None],
Style[1,
Directive[AbsoluteThickness[2], Red]]}]}}}, {ClipPlanes ->
Dynamic@Append[-v, v . center],
HighlightMesh[
DiscretizeRegion[reg1], {Style[0, None],
Style[1, Directive[AbsoluteThickness[2], Dotted, Green]]}],
HighlightMesh[
DiscretizeRegion[reg2], {Style[0, None],
Style[1, Directive[AbsoluteThickness[2], Dotted, Green]]}]},
PointSize[.03], Point[{a, b, c, s}]}, ViewPoint -> Dynamic@v,
ViewProjection -> "Orthographic", Boxed -> False]]