VBA多点拟合圆心代码

Question

已知圆的半径，已知八个点三维坐标，求八个点三维坐标拟合出的圆心坐标。求VBA的源代码，要把提供的源代码直接复制到EXCEL内就可以用。希望你回答问题后直接把代码复制到EXCEL2003的VBA内实验下是否可用。
怎么没人回答呢？

Answer 1

在对应地方输入半径各8点坐标再运行代码。

Sub yuan()
Dim i As double, j As double, x0 As double, y0 As double, difr As integer, r As double, arr(-20 To 20, -20 To 20) As Double
x1 = Range("b3").Value
x2 = Range("b4").Value
x3 = Range("b5").Value
x4 = Range("b6").Value
x5 = Range("b7").Value
x6 = Range("b8").Value
x7 = Range("b9").Value
x8 = Range("b10").Value
y1 = Range("c3").Value
y2 = Range("c4").Value
y3 = Range("c5").Value
y4 = Range("c6").Value
y5 = Range("c7").Value
y6 = Range("c8").Value
y7 = Range("c9").Value
y8 = Range("c10").Value
r = Range("a3").Value
difr = 100

For i = -20 To 20 Step 1
    For j = -20 To 20 Step 1
        k1 = Sqr((x1 - i) * (x1 - i) + (y1 - j) * (y1 - j))
        k2 = Sqr((x2 - i) * (x2 - i) + (y2 - j) * (y2 - j))
        k3 = Sqr((x3 - i) * (x3 - i) + (y3 - j) * (y3 - j))
        k4 = Sqr((x4 - i) * (x4 - i) + (y4 - j) * (y4 - j))
        k5 = Sqr((x5 - i) * (x5 - i) + (y5 - j) * (y5 - j))
        k6 = Sqr((x6 - i) * (x6 - i) + (y6 - j) * (y6 - j))
        k7 = Sqr((x7 - i) * (x7 - i) + (y7 - j) * (y7 - j))
        k8 = Sqr((x8 - i) * (x8 - i) + (y8 - j) * (y8 - j))
        arr(i, j) = (k1 - r) ^ 2 + (k2 - r) ^ 2 + (k3 - r) ^ 2 + (k4 - r) ^ 2 + (k5 - r) ^ 2 + (k6 - r) ^ 2 + (k7 - r) ^ 2 + (k8 - r) ^ 2
           If (difr > arr(i, j)) Then
               difr = arr(i, j)
               x0 = i
               y0 = j
           End If
    Next j
Next i
Range("d3") = x0
Range("e3") = y0
Range("f2") = 1 - difr / (r * r)

End Sub

局限性：拟合范围限定，要自己要根据估计范围改动i和j的范围；拟合程度不高，如果想提高拟合程度可以改step 1为step 0.1或step0.01但越往后运行次数越多，对计算机要求也越高。我没装03版，我用的    excl2010测试可行，不知道2003版行不，但是在2007版以上应该都行。

追问

你看能不能把编号的VBA程序发给我试试。 35806441

追答

我的MSN号：[email protected]