3
$\begingroup$

Given three points A, B and C on a circular arc, I want to get a parametric equation for them, where A is the starting point, C the end point and B the intermediate point on the Arc.

I started with a simple circular arc in the XZ plane, parametric in t:

arcXZ = r {Cos[ω1 + t (ω2 - ω1)], 0, Sin[ω1 + t (ω2 - ω1)]};

Next I rotate and translate it into an arbitrary position

arc={cx, cy, cz} + RotationMatrix[ϕ, {0, 0, 1}].RotationMatrix[θ, {1, 0, 0}].arcXZ;

This gives me three equations, for A, B, and C respectively.

eq1 = arc /. t -> 0;
eq2 = arc /. t-> 1/2;
eq3 = arc /. t-> 1;

I'm trying to solve them using

Solve[
 eq1 == {a1, a2, a3} &&
  eq2 == {b1, b2, b3} &&
  eq3 == {c1, c2, c3},
 {cx, cy, cz, r, ϕ, θ, ω1, ω2}
 ]

But this runs now for over an hour without any result. How can I solve this?

I also tried adding the inequality r>0 and restricting the domain to Reals in trial runs with simpler equations but that seemed to increase the runtime by a lot.

Responding to Carl Woll's comment. For

cx = 0,
cy = 0,
cz = 0,
ϕ = π/4,
θ = π/4,
ω1 = π/3,
ω2 = 3 π/4,
r = 10,

and t={0,1/2,1}

I get Circumsphere does not exist:

Circumsphere[{{10 (1/(2 Sqrt[2]) + Sqrt[3]/4), 
   10 (1/(2 Sqrt[2]) - Sqrt[3]/4), 
   5 Sqrt[3/2]}, {10 (1/2 Cos[\[Pi]/24] - Sin[\[Pi]/24]/Sqrt[2]), 
   10 (-(1/2) Cos[\[Pi]/24] - Sin[\[Pi]/24]/Sqrt[2]), 
   5 Sqrt[2] Cos[\[Pi]/24]}, {10 (-(1/2) + 1/(2 Sqrt[2])), 
   10 (-(1/2) - 1/(2 Sqrt[2])), 5}}]
$\endgroup$
2
  • 2
    $\begingroup$ Have you tried Circumsphere? $\endgroup$
    – Carl Woll
    Commented Oct 2, 2023 at 19:35
  • $\begingroup$ @Carl Woll I tried it now, see above edit. $\endgroup$ Commented Oct 2, 2023 at 19:56

3 Answers 3

4
$\begingroup$
  • Method-1
Clear["Global`*"];
{a, b, c} = RandomReal[{-5, 5}, {3, 3}];

normal = Cross[c - a, c - b] // Simplify;
center = {c1, c2, c3};
sol = NSolve[{(center - a) . (center - a) == (center - b) . (center - 
        b) == (center - c) . (center - c), (center - a) . normal == 
     0}, center];
center = center /. sol[[1]];
r = Sqrt[(center - a) . (center - a)] // Simplify;

{e1, e2} = Orthogonalize[{a - center, b - center}];
circle[t_] = center + r {Cos[t], Sin[t]} . {e1, e2};
{t1, t2, t3} = 
  Sort[NArgMin[{(circle[t] - #) . (circle[t] - #), 0 <= t <= 2 π},
       t] & /@ {a, b, c}];
Show[{ParametricPlot3D[circle[t], {t, t1, t2}, PlotStyle -> Red], 
  ParametricPlot3D[circle[t], {t, t2, t3}, PlotStyle -> Green], 
  ParametricPlot3D[circle[t], {t, t1, t3}, 
   PlotStyle -> Directive[AbsoluteThickness[8], Dashed]]}, 
 PlotRange -> All, ViewPoint -> normal, 
 ViewProjection -> "Orthographic"]

enter image description here

  • Method-2
Clear["Global`*"];
{a, b, c} = RandomReal[{-5, 5}, {3, 3}];
plane[u_, v_] = a + u*(c - a) + v*(b - a);
sol = Block[{center = plane[u, v]}, 
    NSolve[{(center - a) . (center - a) == (center - b) . (center - 
          b) == (center - c) . (center - c)}, {u, v}, Reals]] // First;
center = plane[u, v] /. sol;
{e1, e2} = Orthogonalize[{a - center, b - center}];
x1 = Dot[a - center, e1];
y1 = Dot[a - center, e2];
x2 = Dot[b - center, e1];
y2 = Dot[b - center, e2];
x3 = Dot[c - center, e1];
y3 = Dot[c - center, e2];

{θ1, θ2, θ3} = {ArcTan[x1, y1], ArcTan[x2, y2], 
  ArcTan[x3, y3]}

r = Norm[a - center];
{ParametricPlot3D[
  center + r*{Cos[t], Sin[t]} . {e1, e2}, {t, θ1, θ2}, 
  PlotStyle -> Green], 
 ParametricPlot3D[
  center + r*{Cos[t], Sin[t]} . {e1, e2}, {t, θ2, θ3}, 
  PlotStyle -> Blue], 
 ParametricPlot3D[
  center + r*{Cos[t], Sin[t]} . {e1, e2}, {t, θ3, θ1}, 
  PlotStyle -> Red]}

enter image description here

$\endgroup$
3
$\begingroup$

Here is an example how to get a circular arc in 3D, parametrized by the angle. We first choose some arbitrary points, assuming p1 is the start, p2 somewhere in between and p3 the end:

SeedRandom[1];
{p1, p3, p2} = RandomReal[{-1, 1}, {3, 3}];

Then we get the midpoints of the first and second segment and name the, not yet known, center of the circle: mid:

m1 = (p1 + p2)/2;
m2 = (p2 + p3)/2;
mid = {xm, ym, zm};

With this we can write the equations for the center and calculate the center:

cen = mid /. 
   ToRules[Reduce[{(m1 - mid) . (p1 - p2) == 
       0, (m2 - mid) . (p2 - p3) == 0, 
      mid == p1 + t1 (p1 - p2) + t2 (p1 - p3)}, {xm, y, zm, , t1, 
      t2}]];

We also need the angle between start and end. The angle can be positive or negative. :

ang = VectorAngle[(p1 - cen), (p3 - cen)];
If[(p2 - p1) . (p3 - p2) < 0, ang = ang - 2 Pi];

With this info we can define the parametric arc and draw it:

arc[phi_] := 
  RotationTransform[phi, Cross[p1 - cen, p3 - cen], cen][p1];

d = 3;
Show[{
  ParametricPlot3D[arc[phi], {phi, 0, ang}, PlotRange -> {-d, d}]
  , Graphics3D[{PointSize[0.02], Point[{p1, p2, p3}], Red, Point[cen],
     Green, Line[{{cen, p1}, {cen, p3}}]}]}
 ]

enter image description here

$\endgroup$
2
  • $\begingroup$ SeedRandom[12]; or SeedRandom[123]; indicate that the arc not always through the three points. $\endgroup$
    – cvgmt
    Commented Oct 2, 2023 at 22:09
  • $\begingroup$ The problem is that I choose,for simplicity, the smaller angle between p1 and p3. To make it foolproof, you need to check if VectorAngle is correct or if you must use VectorAngle - 2Pi. $\endgroup$ Commented Oct 3, 2023 at 6:49
2
$\begingroup$

EDIT: Here's a 3D implicit fit, parametric fit is left as an exercise to the reader:

With[{pts =
   {{1, 2, 3},
    {3, 4, 5},
    {5, 6, 8}}},
 RegionIntersection[
    Sphere[{x, y, z}, r],
    Hyperplane[{u, v, w}, {x, y, z} . {u, v, w}]] /.
   First[Solve[
     Append[
      Thread@Element[# - {x, y, z} & /@ pts,
        RegionIntersection[
         Sphere[{0, 0, 0}, r],
         Hyperplane[{u, v, w}, 0]]],
      Element[{u, v, w}, Sphere[]]],
     {x, y, z, r, u, v, w}, Reals]] //
  Show[
    Region[Style[Echo[#], Black]],
    Graphics3D[{Red, PointSize[Large], Point@pts}]] &]

(* BooleanRegion[#1&&#2&,{Sphere[{-(23/4),-(19/4),39/2},(3 Sqrt[323/2])/2],
    Hyperplane[{-(1/Sqrt[2]),1/Sqrt[2],0},1/Sqrt[2]]}] *)

enter image description here

This is an explicit instead of a parametric fit, but I'd guess it's a start:

With[{pts =
   {{1, 2},
    {3, 4},
    {4, 6}}},
 Graphics[
  {Echo[Circle[{x, y}, r] /.
     First[Solve[Thread[Element[pts, Circle[{x, y}, r]]], {x, y, r}]]],
   Red, PointSize[Large], Point[pts]}]]

(* Circle[{-(7/2),17/2},5 Sqrt[5/2]] *)

enter image description here

Here's a parametric solution on basis of the above:

With[{pts =
   {{1, 2},
    {3, 4},
    {4, 6}}},
 r {Sin[t], Cos[t]} + {x, y} /.
  First[Solve[Thread[Element[pts, Circle[{x, y}, r]]], {x, y, r}]]]

(* {-(7/2) + 5 Sqrt[5/2] Sin[t], 17/2 + 5 Sqrt[5/2] Cos[t]} *)
$\endgroup$
2
  • $\begingroup$ Nice start, but this is only two dimensional. $\endgroup$ Commented Oct 2, 2023 at 19:57
  • $\begingroup$ Ah, I must be tired, I missed that part... $\endgroup$
    – kirma
    Commented Oct 2, 2023 at 20:34

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.