It looks to me that the general solution is rather complex to do on a
worksheet. Therefore, I only attempted this as a vba solution. I don't
know how your data is set up. Therefore, I have set this up using A1:C4,
with x's in Column 'A', etc. I think I've done this correctly, but I have
not fully tested it. You will have to adjust it to your own situation.
HTH. Dana
Sub Demo()
'// = = = = = = = = = = = = = = =
'// By: Dana DeLouis
'// Center of Sphere, 4-Point
'// Finds Center of Sphere given 4 (x,y,z) points
'// This Demo uses A1:C4, with each column holding x,y,z values
'// = = = = = = = = = = = = = = =
'Input array
Dim v
'Temp variables
Dim k, t, t1, t2, t3, t4
Dim vt, vx, vy, vz, v1
'Sphere centered at {x,y,z}, with Radius r
Dim x, y, z, r
Dim Sphere
With WorksheetFunction
' Get Data
v = [A1:C4]
'// Vectors of x^2+y^2+z^2
vt = Array( _
.SumSq(.Index(v, 1, 0)), _
.SumSq(.Index(v, 2, 0)), _
.SumSq(.Index(v, 3, 0)), _
.SumSq(.Index(v, 4, 0)))
'// Vector of x's, y's, z's, & 1's
vx = .Transpose(.Index(v, 0, 1))
vy = .Transpose(.Index(v, 0, 2))
vz = .Transpose(.Index(v, 0, 3))
v1 = Array(1, 1, 1, 1)
k = .MDeterm(.Transpose(Array(vx, vy, vz, v1)))
'Center @ x
x = .MDeterm(.Transpose(Array(vt, vy, vz, v1))) / k / 2
'Center @ y
y = .MDeterm(.Transpose(Array(vt, vx, vz, v1))) / k / -2
'Center @ z
z = .MDeterm(.Transpose(Array(vt, vx, vy, v1))) / k / 2
'Radius
r = Sqr(.SumSq(x, y, z) - (.MDeterm(.Transpose(Array(vt, vx, vy, vz))) /
k))
'You may want to return the solution as an Array
Sphere = Array(x, y, z, r)
End With
End Sub
