       Equation for Circle in 3-D surrounding Equilateral Triangle

• To: mathgroup at smc.vnet.net
• Subject: [mg2321] Equation for Circle in 3-D surrounding Equilateral Triangle
• From: DUGGAN at ecs.umass.edu
• Date: Tue, 24 Oct 1995 02:13:57 -0400

(*

Hello,

The question is:

Given three point at the intersection of the sides of an Equilateral triangle
in 3D what is and how does one code Mathematica for the equation of the circle
in 3D that contains all 3 points. I felt that the intersection of a sphere
and a plane would solve the problem. But my mathematica coding appears to fall
short for this.

Any help would be greatly appreciated.

Sincerely,

John F. Duggan
Engineering Computer Services
Univ. of Mass.
Amherst, MA

duggan at ecs.umass.edu

*)

(* ========================================================================== *)

(* Code to Generate the Center of the Sphere used later for Input to
form Intersection of Sphere and Place. *)

Clear[p1,p2,p3,xyz, EQ1, EQ2, EQ3, ans, x, y, z]

p1 = { -0.256, -0.256, 3.423 };
p2 = {-3.206, 0.474, -2.690 };
p3 = {-6.532, 2.766, 2.769 };

(* Used to symbolically represent center point for this set of equations *)

xyz = {x,y,z};

{* Create Equations to represent the distance from each point on the triangle
to the center *)

EQ1 = (xyz-p1) . (xyz-p1);
EQ2 = (xyz-p2) . (xyz-p2);
EQ3 = (xyz-p3) . (xyz-p3);

(* Solve the system of 3 Equations in 3 variables *)

ans = Reduce [ EQ1 == EQ2 && EQ2 == EQ1 && EQ1 == EQ3, {x,y,z} ];
ans = { ans[][], ans[][] };

x = ans[];
y = ans[];

ans = Reduce [ EQ1 == EQ2, {z}];
z = ans[];

(* Actual center point *)

c = {x,y,z} ;

Show[ Graphics3D[Line [{p1,p2,p3,p1}]]]
Show[ Graphics3D[Line [{p1,p2,p3,p1,c,p2,p3,c}]]]

(* Radius of the Sphere *)

r = Sqrt[(p1-c) . (p1-c)];

(* ========================================================================== *)

Clear[x,y,z,xyz,EQ1,EQ2,EQ3]

(* define a symbolic vector or point *)

xyz = {x,y,z};

(* create the equation for the sphere *)

EQ1 = ((xyz-c) . (xyz-c)) - (r^2);

(* call Reduce to determine the max and min values for
x, y, and z *)

xrange = Reduce [ ( xyz[] -c[])^2  == r^2, x ];
xrange = {xrange[][], xrange[][]};

yrange = Reduce [ ( xyz[] -c[])^2  == r^2, y ];
yrange = {yrange[][], yrange[][]};

zrange = Reduce [ ( xyz[] - c[] )^2  == r^2, z ];
zrange = {zrange[][], zrange[][]};

xvalues = Reduce [ EQ1 == 0, x ];
xvalues = { xvalues[][][], xvalues[][][] };

{xrange, yrange, zrange}
xvalues[]
xvalues[]

xv1[y_,z_] = xvalues[];
xv2[y_,z_] = xvalues[];

(* initialize the vectors used to create the plane  *)

p1p2 = p2-p1;
p1p3 = p3-p1;
Needs["LinearAlgebra`CrossProduct`"];
n = Cross [ p1p2, p1p3 ];
EQ2 = n . (xyz-p1)
ZEQ2 = ( n[] ( xyz[] - p1[] ) + n[] ( xyz[] - p1[] ) +
n[] p1[] ) /n[]
ZEQ1 = Reduce [ EQ1 == 0, z ]
ZEQ1 = { ZEQ1 [][], ZEQ1[][] }
EQ2
q = Reduce [ EQ1 == EQ2, x]
Dimensions[q];

Plot3D [ ZEQ2, {x, xrange[], xrange[]}, {y,yrange[],yrange[]}]
Plot3D [ ZEQ1[], {x, xrange[], xrange[]}, {y,yrange[],yrange[]}]
Plot3D [ ZEQ1[], {x, xrange[], xrange[]}, {y,yrange[],yrange[]}]

• Prev by Date: Re: Log Plots
• Next by Date: PC and MAC MMA compatibility
• Previous by thread: Mathematica Question
• Next by thread: PC and MAC MMA compatibility