# How to draw a Circle in 3D on a sphere [duplicate]

The Circle function is strictly a 2D Graphics object, so that we cannot directly combine a Circle with a Graphics3D object such as a sphere:

 Show[{ Graphics3D[Sphere[] , Circle[]] }]


(* Circle is not a Graphics3D primitive or directive *)

How can I draw circle in 3D?

For example consider a unit Sphere[] centered at the origin. How can we draw a circle passing through a specified point with the circle center along a vector passing through a second point.

## marked as duplicate by Michael E2, Bob Hanlon, Dr. belisarius, rcollyer, bbgodfreyApr 27 '15 at 23:13

• Did you try something ? Like reading in the documentation about Graphics ? – Sektor Apr 10 '15 at 19:51
• @kuba @sektor Now now. Using the undocumented function Read@Mind[{}] is not for everyone. Isn't there a badge for achieving the Beginner's Mind? – TransferOrbit Apr 11 '15 at 1:22
• If the center of the circle lies on the sphere it is impossible that the circle itself lies on the sphere. – Sjoerd C. de Vries Apr 11 '15 at 15:25
• I hope its ok, I took the liberty of improving the question because there are a number of good answers here..and the question appears in danger of being closed. – george2079 Apr 13 '15 at 15:02
• Possible duplicates: mathematica.stackexchange.com/q/6526, mathematica.stackexchange.com/q/10957 – Michael E2 Apr 27 '15 at 12:32

# Circle

Let's create circle3D that is something you would expect from Circle but with an extra argument for its normal vector.

With

circle3D[centre_: {0, 0, 0}, radius_: 1, normal_: {0, 0, 1}, angle_: {0, 2 Pi}] :=
Composition[
Line,
Map[RotationTransform[{{0, 0, 1}, normal}, centre], #] &,
Map[Append[#, Last@centre] &, #] &,
Append[DeleteDuplicates[Most@#], Last@#] &,
Level[#, {-2}] &,
MeshPrimitives[#, 1] &,
DiscretizeRegion,
If
][
First@Differences@angle >= 2 Pi,
]


we can produce, for example, the following.

A unit circle centred at the origin with the z-axis as its normal:

Graphics3D[circle3D[]]


A unit circle centred at {2, 3, 4} with the z-axis as its normal:

Graphics3D[circle3D[{2, 3, 4}, 2]]


A circle centred at {2, 3, 4} with radius 2 and the z-axis as its normal:

Graphics3D[circle3D[{2, 3, 4}, 2]]


A circle centred at {2, 3, 4} with radius 2 and normal vector pointing in the direction of $\hat\imath - \hat\jmath + \hat{k}$:

Graphics3D[circle3D[{2, 3, 4}, 2, {1, -1, 1}]]


An arc, drawn from 0 to 180 degrees, of a circle whose origin is centred at {2, 3, 4}, radius is 2, and normal vector points in the direction of $\hat\imath - \hat\jmath + \hat{k}$:

Graphics3D[circle3D[{2, 3, 4}, 2, {1, -1, 1}, {0, 180 Degree}]]


# Neat Examples

tocartesian = CoordinateTransformData["Spherical" -> "Cartesian", "Mapping"];
circle3D[{0, 0, 0}, #1, tocartesian[{#1, #2, 0}]] &,
{Range[37], Range[0 Degree, 360 Degree, 10 Degree]}
];
ListAnimate@Table[
Graphics3D[
Rotate[#, n Degree, {0, 1, 0}] & /@ circles,
Boxed -> False,
PlotRange -> 37 {{-1, 1}, {-1, 1}, {-1, 1}}
],
{n, 180}
]


tocartesian = CoordinateTransformData["Spherical" -> "Cartesian", "Mapping"];
spherecentre = RandomReal[{-1, 1}, 3];
randcirc := Module[
randompoint = TranslationTransform[spherecentre][
RandomReal[{0, 2 Pi}]}]
];
{
RandomColor[],
Sphere[randompoint, dotsize],
circle3D[
spherecentre +
randompoint - spherecentre
]
}
];
Graphics3D[
{
Thick,
Table[randcirc, {10}]
},
Boxed -> False
]


# Extras

## Disk

Likewise, we can construct disk3D that behaves like Disk but with an extra argument for its normal vector.

disk3D[centre_: {0, 0, 0}, radius_: 1, normal_: {0, 0, 1}, angle_: {0, 2 Pi}] :=
Polygon[
Map[RotationTransform[{{0, 0, 1}, normal}, centre]][
If[First@Differences@angle >= 2 Pi, #, Append[#, centre]] &[
Map[Append[#, Last@centre] &][
SortBy[#, sortf[#, Most@centre] &] &[
MeshCoordinates[DiscretizeRegion[
]]]]]]]
sortf := Composition[
If[Negative[#], # + 2 Pi, #] &,
N[ArcTan @@ (#1 - #2)] &
]


Examples:

Graphics3D[disk3D[]]


Graphics3D[disk3D[{2, 3, 4}, 2, {1, -1, 1}, {30 Degree, 180 Degree}]]


It's a Polygon after all, so it behaves just like any other region object in Mathematica. You can execute, for example,

RegionMeasure[disk3D[{2, 3, 4}, 2, {1, -1, 1}, {30 Degree, 180 Degree}]]


and get the area:

5.2232

or style it like

disk = disk3D[{2, 3, 4}, 2, {1, -1, 1}, {30 Degree, 180 Degree}];
Graphics3D[{EdgeForm[], Red, disk}]


## Ellipse

After circle3D, why not ellipse3D as well?

ellipse3D[centre_: {0, 0, 0}, radii_: {1, 1}, normal_: {0, 0, 1}] :=
Polygon[
RotationTransform[{{0, 0, 1}, normal}, centre][
Map[Append[#, Last@centre] &][
SortBy[#, N[ArcTan @@ (# - Most@centre)] &] &[
MeshCoordinates[BoundaryDiscretizeRegion[
]]]]]]


Graphics3D[ellipse3D[]] is equivalent to Graphics3D[circle3D[]]:

Graphics3D[ellipse3D[{2, 3, 4}, {1, 2}, {1, -1, 1}]]


RegionMeasure[ellipse3D[{2, 3, 4}, {1, 2}, {1, -1, 1}]]


6.25978

which is a little bit off from that of the same ellipse in 2D:

RegionMeasure[Ellipsoid[{2, 3}, {1, 2}]]


due to the discretisation.

• Graphics3D[disk3D[{2,3,4},2,{1,-1,1},{90 Degree,270 Degree}]]has problem. – kittygirl Mar 17 '18 at 15:25
• @kittygirl Hmmmm I've got to change the SortBy Line somehow... – Taiki Jun 2 '18 at 11:04
• @kittygirl disk3D updated and tested. – Taiki Jun 4 '18 at 14:17
• Brilliant example!! Very useful for me. Thanks !!! – KratosMath Jul 31 '18 at 14:59
• @MsenRezaee You’re welcome! – Taiki Jul 31 '18 at 16:44
center = Normalize@{1, 2, 3};
point = Normalize@{0, 2, 1};


with minimum of algebra:

Show[
ParametricPlot3D[
Evaluate[ N[center + RotationMatrix[t, center].(point - center)]],
{t, 0, 2 Pi}],
Graphics3D[{Sphere[], Blue, Sphere[{center, point}, .05]}]
, PlotRange -> 1.1
]


• I'm encouraging future readers to keeps scrolling down. Nice answers are awaiting attention :) – Kuba Apr 27 '15 at 11:38

circle is 2D and sphere is 3D. Hence you are missing one dimension to make them both show together. i.e. you need orientation for the circle.

This should get you started. You can approximate a circle with Cylinder of very small length.

Graphics3D[{
{Red, Cylinder[{{1, 0, 0}, {1.01, 0, 0}}, 1]},
Sphere[{0, 0, 0}, 1]
}, Boxed -> False]


• even do: EdgeForm[Red], FaceForm[Transparent] ..to actually have just a circle. – george2079 Apr 13 '15 at 15:57
• Yes, this is very clever. I was thinking of somehow modifying a Cone[.] instead, but this is way better. – Matsmath Sep 16 '18 at 16:00

You can also plot two partial spheres and highlight where they meet

 smallSphere = ParametricPlot3D[
{Cos[θ] Sin[ϕ], Cos[θ] Cos[ϕ], Sin[θ]},
{θ, -π, π}, {ϕ, -π/2, π/2},
Mesh -> None,
PlotStyle -> {LightBlue, Opacity[0.4]},
BoundaryStyle -> Directive[Thick, Red],
RegionFunction -> (#2 > .6 &)
];
bigSphere = ParametricPlot3D[
{Cos[θ] Sin[ϕ], Cos[θ] Cos[ϕ], Sin[θ]},
{θ, -π, π}, {ϕ, -π/2, π/2},
Mesh -> None,
PlotStyle -> {Blue, Opacity[0.5]},
RegionFunction -> (#2 < .6 &)
];
Show[bigSphere, smallSphere, PlotRange -> All, Axes -> None, Boxed -> False]


draw[sphere : {sC_, sR_}, circle: {ctr_, pt_}] :=
ParametricPlot3D[sR {Cos[u] Sin[v],Sin[u] Sin[v],Cos[v]}+sC, {u,0,2 Pi}, {v,0,2 Pi},
MeshFunctions -> (Norm[{##}[[1;;3]]-ctr] - Norm[ctr-pt] &), Mesh -> {{0}}]

SeedRandom[42];
sCenter = {1, 1, 1}; sRadius = 1;
cs = Map[Plus[Normalize[#], sCenter] &, RandomReal[{-1, 1} sRadius, {10, 2, 3}], {2}]
draw[{sCenter, sRadius}, #] & /@ cs // Show


Also

f[r_, u_, v_]= CoordinateTransformData["Spherical"->"Cartesian","Mapping",{r, u, v}];

draw1[sphere : {sphC_, sphR_}, ctr_, pt_] :=
ParametricPlot3D[f[sphR, u, v] + sphC, {u, 0, 2 Pi}, {v, 0, 2 Pi},
MeshFunctions -> Function[{x, y, z, u, v}, Norm[{x, y, z} - ctr] - Norm[ctr- pt]],
Mesh -> {{0}}]

draw1[{{1, 1, 1}, 1}, {1, 1, 2}, {1, 0, 1}]


You can also use Exclusions with ParametricPlot3D:

ParametricPlot3D[{Cos[u] Sin[v], Cos[u] Cos[v], Sin[u]}, {u, -π, π}, {v, -π/2, π/2},
Mesh -> None, PlotStyle -> Opacity[.25, Blue], PlotPoints -> 80, MaxRecursion -> 4,
Exclusions -> {Cos[u] Cos[v] == .7},
ExclusionsStyle -> ({Directive[Opacity[1], Thick, Red]})]


I've found this useful on a number of occasions: use a BezierCurve, which can be a 3D object, to approximate a circle.

 bezierarc[xc_, a_, b_ , r_: 1, n_: {0, 0, 1}] :=
(* Bezier approximation to an arc *)
(*Excellent approximation for included angle b-a < Pi/2 *)
(* "pretty good" approximation for b-a< Pi *)
Module[{rstar, del, p, c, d},
c = (a + b)/2;
d = (a - b)/2;
rstar = (8 - ( Cos@a + Cos@b )/Cos@c )/6;
del = (13 Sin@d - 8  Sin[d/2] Sqrt[14 + 2 Cos@d ])/9;
p = r {
{Cos[a], Sin[a]} ,
rstar {Cos[c], Sin[c]} -   del {-Sin[c], Cos[c]} ,
rstar  {Cos[c], Sin[c]} +   del  {-Sin[c], Cos[c]} ,
{Cos[b], Sin[b]}};
If[Length[xc] == 3 ,
p = RotationMatrix[{ {0, 0, 1}, n}]. Append[#, 0] & /@ p];
BezierCurve[xc + # & /@ p]]
beziercircle[xc_, r_: 1, n_: {0, 0, 1}] :=
bezierarc[xc, Sequence @@ # , r, n ] & /@  (Pi /2 Partition[Range[0, 4], 2, 1])


This is designed to work in 2- or 3-d:

 GraphicsRow[{Graphics@beziercircle[{0, 0}, 1] ,
Graphics3D@{beziercircle[{0, 0, 0}, 1, {1, 1, 1}],
Line[{{0, 0, 0}, {1, 1, 1}}] }}]


for the example at hand,

   center = Normalize@{1, 2, 3};
point = Normalize@{0, 2, 1};


of course the true circle center is not actually on the sphere so we need to do a bit of math:

 cc = center First@
Select[ f /.
Solve[ (f center  - point ).(f center) == 0 , f ] , # > 0 & ]
Graphics3D[{ Sphere[] , Thick, Red,
beziercircle[cc, Norm[point - cc], center] , Blue,
Sphere[#, .05] & /@ {center, point}}]