Given three points in space, find center of circle

Question

Given the coordinates of three points in space, {x1,y1,z1}, {x2,y2,z2}, {x3,y3,z3}, how can I find the coordinates of the center of the circle that passes through the three points?

There is the function CircleThrough, but it only works for 2-dimensions.

Answer 1

Given 3 point, search the center of the circle through these points.

The center of the circle must lay in the same plane as p1,p2,p3, therefore we can write:

SeedRandom[12];
{p1, p2, p3} = RandomReal[{-1, 1}, {3, 3}];
c = p3 + l1 (p1 - p3) + l2 (p2 - p3);

with the center c and unknowns l1 and l2. These are determined by the condition that the distance to the center is the same for all points:

dis = (# - c) . (# - c) & /@ {p1, p2, p3};
eq = dis[[1]] == dis[[2]] == dis[[3]] // Simplify // Chop;

We solve these equations for l1 and l2 and get the center:

sol = Solve[eq, {l1, l2}][[1]] // Chop;
center = c /. sol /. l1 -> 1 // Simplify;

the distance from the points to the center:

Norm[# - center] & /@ {p1, p2, p3}
(* {0.833413, 0.833413, 0.833413} *)
Graphics3D[{
  Cylinder[{center, center + 0.001 Cross[p1 - p3, p2 - p3]}, 
   Norm[p1 - center]], PointSize[0.03], Blue, Point[{p1, p2, p3}], 
  Red, Point[center]
  }]

Answer 2

Based on How to determine the center and radius of a circle given some points in 3D?.

circleThrough3D[p1_, p2_, p3_] := 
 Module[{v1, v2, n, eqs, x, y, z, r, solution, x0, y0, z0, r0},
  v1 = p2 - p1;
  v2 = p3 - p1;
  {v1, v2} = Orthogonalize[{v1, v2}];
  n = Cross[v1, v2];
  eqs = {(x - p1[[1]])^2 + (y - p1[[2]])^2 + (z - p1[[3]])^2 == 
     r^2, (x - p2[[1]])^2 + (y - p2[[2]])^2 + (z - p2[[3]])^2 == 
     r^2, (x - p3[[1]])^2 + (y - p3[[2]])^2 + (z - p3[[3]])^2 == r^2, 
    n . ({x, y, z} - p1) == 0};
  solution = NSolve[eqs, {x, y, z, r}];
  {x0, y0, z0} = {x, y, z} /. First[solution];
  r0 = r /. First[solution];
  {{x0, y0, z0}, r0}]

Answer 3

SeedRandom[1];
{p[1], p[2], p[3]} = RandomReal[{}, {3, 3}];
sol = NMaximize[{0, p[1] ∈ Sphere[{x, y, z}, r], 
     p[2] ∈ Sphere[{x, y, z}, r], 
     p[3] ∈ Sphere[{x, y, z}, r], {x, y, z} ∈ 
      InfinitePlane[Array[p, 3]]}, {x, y, z, r}][[2]];
reg = DiscretizeRegion@
   RegionIntersection[InfinitePlane[Array[p, 3]], 
    Ball[{x, y, z}, r] /. sol];
Graphics3D[{{EdgeForm[], Yellow, reg}, {PointSize[Large], Red, 
    Point[{x, y, z}], Cyan, Point[Array[p, 3]]}, {Opacity[.5], 
    Sphere[{x, y, z}, r]}}] /. sol

Answer 4

centerRadius = Module[{ctr = Array[c, 3]}, 
   {ctr /. #[[2]], #[[1]]} & @
     NMinimize[{Norm[#[[1]] - ctr], Equal @@ (Norm[# - ctr] & /@ #) && 
        Element[ctr, InfinitePlane[#]]}, ctr]] &;

ballThrough = Sphere @@ centerRadius @ # &; 

circleThrough3D = MeshPrimitives[
   DiscretizeRegion @ RegionIntersection[InfinitePlane @ #, ballThrough @ #], 1, 
   Multicells -> True] &;

Example:

SeedRandom[1];
pts = RandomReal[1, {3, 3}];
centerRadius @ pts

 {{-0.385104, -0.938733, 0.999601}, 1.61026}

Graphics3D[{{Opacity[.5], ballThrough @ pts}, 
  {PointSize[Large], Red, Point @ pts,
   Blue, Point @ First @ centerRadius @ pts, 
   Thick, circleThrough3D @ pts}}, Boxed -> False]