四面体(三角錐)の内接球のsympyを探しています。 vbaソルバーでやってみました。


①四面体(三角錐)の内接球のsympyを探しています。他言語でも。  
②vbaソルバーで実行してみました。vbaコードを短くする方法を教えて下さい。一例しか実行していません。  
➂以下のコードの、「Range("A7").Formula」複数行で書けませんでした。  
よろしくお願いします。

オリジナルポスト  
(0,0,0),(1,0,0),(0,1,0),(0,0,2)  
「2021年度 九州大・理系数学問題1(1)」  
<https://www.densu.jp/kyusyu/21kyusyuspass.pdf>

参考  
「CASIO＞３点を含む平面の式,４点で形成される四面体の体積」  
<https://keisan.casio.jp/exec/system/1202458197>  
<https://keisan.casio.jp/exec/system/1202458218>  
「Wolfram|Alpha」  
<https://ja.wolframalpha.com/input/?i=%280%2C0%2C0%29%2C%281%2C0%2C0%29%2C%280%2C1%2C0%29%2C%280%2C0%2C2%29>  
<https://ja.wolframalpha.com/input/?i=%E4%B8%89%E8%A7%92%E9%8C%90%EF%BC%880%2C0%2C0%29%2C%281%2C0%2C0%29%2C%280%2C1%2C0%29%2C%280%2C0%2C2%29>

[code]

    Const Ax = 0
    Const Ay = 0
    Const Az = 0
    Const Bx = 1
    Const By = 0
    Const Bz = 0
    Const Cx = 0
    Const Cy = 1
    Const Cz = 0
    Const Dx = 0
    Const Dy = 0
    Const Dz = 2
    Function myHeimen(Ax, Ay, Az, Bx, By, Bz, Cx, Cy, Cz)
       a = (By - Ay) * (Cz - Az) - (Cy - Ay) * (Bz - Az)
       b = (Bz - Az) * (Cx - Ax) - (Cz - Az) * (Bx - Ax)
       c = (Bx - Ax) * (Cy - Ay) - (Cx - Ax) * (By - Ay)
       d = -(a * Ax + b * Ay + c * Az)
       myHeimen = Array(a, b, c, d)
    End Function
    Function mySimentaiTaiseki(x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4)
       mySimentaiTaiseki = _
                         ((x4 - x1) * Abs(y2 - y1) * (z3 - z1) - (z3 - z1) * (y3 - y1) _
                        + (y4 - y1) * Abs(z2 - z1) * (x3 - x1) - (x2 - x1) * (z3 - z1) _
                        + (z4 - z1) * Abs(x2 - x1) * (y3 - y1) - (y2 - y1) * (x3 - x1)) / 6#
    End Function
    Function myDis(x1, y1, z1, x2, y2, z2)
        myDis = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2 + (z1 - z2) ^ 2)
    End Function
    Function myHeron(x1, y1, z1, x2, y2, z2, x3, y3, z3)
        s = (myDis(x1, y1, z1, x2, y2, z2) + myDis(x2, y2, z2, x3, y3, z3) + myDis(x3, y3, z3, x1, y1, z1)) / 2#
        myHeron = Sqr(s * (s - myDis(x1, y1, z1, x2, y2, z2)) * (s - myDis(x2, y2, z2, x3, y3, z3)) * (s - myDis(x3, y3, z3, x1, y1, z1)))
    End Function
    Function mySimentaiMenseki(x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4)
        mySimentaiMenseki = _
            myHeron(x1, y1, z1, x2, y2, z2, x3, y3, z3) _
          + myHeron(x2, y2, z2, x3, y3, z3, x4, y4, z4) _
          + myHeron(x3, y3, z3, x4, y4, z4, x1, y1, z1) _
          + myHeron(x4, y4, z4, x1, y1, z1, x2, y2, z2)
    End Function
    Sub aaa_Sankakusui()
        Dim vD As Variant
        Dim vA As Variant
        Dim vB As Variant
        Dim vC As Variant
        ActiveSheet.Cells.Clear
    '
    MsgBox "四面体(三角錐)の内接球をソルバーで計算します。"
    '
        Range("A1") = Ax
        Range("B1") = Ay
        Range("C1") = Az
        Range("A2") = Bx
        Range("B2") = By
        Range("C2") = Bz
        Range("A3") = Cx
        Range("B3") = Cy
        Range("C3") = Cz
        Range("A4") = Dx
        Range("B4") = Dy
        Range("C4") = Dz
        Range("A5") = mySimentaiTaiseki(Ax, Ay, Az, Bx, By, Bz, Cx, Cy, Cz, Dx, Dy, Dz)
        Range("B5") = mySimentaiMenseki(Ax, Ay, Az, Bx, By, Bz, Cx, Cy, Cz, Dx, Dy, Dz)
        Range("C5").Formula = "= A5*3.0/B5"
    '
        vD = myHeimen(Ax, Ay, Az, Bx, By, Bz, Cx, Cy, Cz)
        vA = myHeimen(Bx, By, Bz, Cx, Cy, Cz, Dx, Dy, Dz)
        vB = myHeimen(Cx, Cy, Cz, Dx, Dy, Dz, Ax, Ay, Az)
        vC = myHeimen(Dx, Dy, Dz, Ax, Ay, Az, Bx, By, Bz)
    '       "
        Range("E1") = vD(0)
        Range("F1") = vD(1)
        Range("G1") = vD(2)
        Range("H1") = vD(3)
        Range("E2") = vA(0)
        Range("F2") = vA(1)
        Range("G2") = vA(2)
        Range("H2") = vA(3)
        Range("E3") = vB(0)
        Range("F3") = vB(1)
        Range("G3") = vB(2)
        Range("H3") = vB(3)
        Range("E4") = vC(0)
        Range("F4") = vC(1)
        Range("G4") = vC(2)
        Range("H4") = vC(3)
        Range("A7").Formula = "= (Abs(E1 * A6 + F1 * B6 + G1 * C6 + H1) / Sqrt(E1 ^ 2 + F1 ^ 2 + G1 ^ 2) - C5) ^ 2   + (Abs(E2 * A6 + F2 * B6 + G2 * C6 + H2) / Sqrt(E2 ^ 2 + F2 ^ 2 + G2 ^ 2) - C5) ^ 2 + (Abs(E3 * A6 + F3 * B6 + G3 * C6 + H3) / Sqrt(E3 ^ 2 + F3 ^ 2 + G3 ^ 2) - C5) ^ 2  + (Abs(E4 * A6 + F4 * B6 + G4 * C6 + H4) / Sqrt(E4 ^ 2 + F4 ^ 2 + G4 ^ 2) - C5) ^ 2"
        Dim ws As Worksheet: Set ws = ActiveSheet
        SolverReset
        SolverOk setCell:=ws.Range("A7"), _
                       MaxMinVal:=3, _
                       ByChange:=ws.Range("A6:C6"), _
                       EngineDesc:="GRG Nonlinear"
         SolverSolve UserFinish:=True
    End Sub
    '結果
    '半径　0.249999801614916
    '四面体に内接する球の中心座標　0.249999705 0.249999822 0.249999802
    
[/code]




vbaソルバー（その2)  
変化させるセル(変数セル) に球の半径も追加しました。その結果、表面積と体積の計算が不要になりました。

[code]

    Const Ax = 0
    Const Ay = 0
    Const Az = 0
    Const Bx = 1
    Const By = 0
    Const Bz = 0
    Const Cx = 0
    Const Cy = 1
    Const Cz = 0
    Const Dx = 0
    Const Dy = 0
    Const Dz = 2
    Function myHeimen(Ax, Ay, Az, Bx, By, Bz, Cx, Cy, Cz)
       a = (By - Ay) * (Cz - Az) - (Cy - Ay) * (Bz - Az)
       b = (Bz - Az) * (Cx - Ax) - (Cz - Az) * (Bx - Ax)
       c = (Bx - Ax) * (Cy - Ay) - (Cx - Ax) * (By - Ay)
       d = -(a * Ax + b * Ay + c * Az)
       myHeimen = Array(a, b, c, d)
    End Function
    Sub aaa_Sankakusui()
        Dim vD As Variant
        Dim vA As Variant
        Dim vB As Variant
        Dim vC As Variant
        ActiveSheet.Cells.Clear
    '
    MsgBox "'四面体(三角錐)の内接球をソルバーで計算します。"
    '
        Range("A1") = Ax
        Range("B1") = Ay
        Range("C1") = Az
        Range("A2") = Bx
        Range("B2") = By
        Range("C2") = Bz
        Range("A3") = Cx
        Range("B3") = Cy
        Range("C3") = Cz
        Range("A4") = Dx
        Range("B4") = Dy
        Range("C4") = Dz
    '
        vD = myHeimen(Ax, Ay, Az, Bx, By, Bz, Cx, Cy, Cz)
        vA = myHeimen(Bx, By, Bz, Cx, Cy, Cz, Dx, Dy, Dz)
        vB = myHeimen(Cx, Cy, Cz, Dx, Dy, Dz, Ax, Ay, Az)
        vC = myHeimen(Dx, Dy, Dz, Ax, Ay, Az, Bx, By, Bz)
    '       "
        Range("E1") = vD(0)
        Range("F1") = vD(1)
        Range("G1") = vD(2)
        Range("H1") = vD(3)
        Range("E2") = vA(0)
        Range("F2") = vA(1)
        Range("G2") = vA(2)
        Range("H2") = vA(3)
        Range("E3") = vB(0)
        Range("F3") = vB(1)
        Range("G3") = vB(2)
        Range("H3") = vB(3)
        Range("E4") = vC(0)
        Range("F4") = vC(1)
        Range("G4") = vC(2)
        Range("H4") = vC(3)
        Range("A7").Formula = "= (Abs(E1 * A6 + F1 * B6 + G1 * C6 + H1) / Sqrt(E1 ^ 2 + F1 ^ 2 + G1 ^ 2) - D6) ^ 2   + (Abs(E2 * A6 + F2 * B6 + G2 * C6 + H2) / Sqrt(E2 ^ 2 + F2 ^ 2 + G2 ^ 2) - D6) ^ 2 + (Abs(E3 * A6 + F3 * B6 + G3 * C6 + H3) / Sqrt(E3 ^ 2 + F3 ^ 2 + G3 ^ 2) - D6) ^ 2  + (Abs(E4 * A6 + F4 * B6 + G4 * C6 + H4) / Sqrt(E4 ^ 2 + F4 ^ 2 + G4 ^ 2) - D6) ^ 2"
        Dim ws As Worksheet: Set ws = ActiveSheet
        SolverReset
        SolverOk setCell:=ws.Range("A7"), _
                       MaxMinVal:=3, _
                       ByChange:=ws.Range("A6:D6"), _
                       EngineDesc:="GRG Nonlinear"
         SolverSolve UserFinish:=True
    End Sub
    '結果
    '半径 0.249999512642834
    '四面体に内接する球の中心座標 0.250000201 0.249999942 0.249998773
    
[/code]

