CyberChaos(さいばかおす)

プログラミング言語、トランスパイラ、RPA、ChatGPT、データマイニング、リバースエンジニアリングのための忘備録

任意の3点を通る円を描くVBAソースコード

2023-03-25 15:14:22 | VBA

Sub DrawCircleFromThreePoints()

    Dim x1, x2, x3, y1, y2, y3 As Double
    Dim a, b, c, d, e, f As Double
    Dim xCenter, yCenter, radius As Double
    Dim s, t As Double
    Dim Msg As String
    
    '3つの点を取得
    x1 = InputBox("最初の点のx座標を入力してください")
    y1 = InputBox("最初の点のy座標を入力してください")
    x2 = InputBox("2番目の点のx座標を入力してください")
    y2 = InputBox("2番目の点のy座標を入力してください")
    x3 = InputBox("3番目の点のx座標を入力してください")
    y3 = InputBox("3番目の点のy座標を入力してください")
    
    '円の中心と半径を計算
    a = x1 - x2
    b = y1 - y2
    c = x1 - x3
    d = y1 - y3
    e = (x1 * x1 - x2 * x2 + y1 * y1 - y2 * y2) / 2
    f = (x1 * x1 - x3 * x3 + y1 * y1 - y3 * y3) / 2
    
    s = (d * e - b * f) / (a * d - b * c)
    t = (a * f - c * e) / (a * d - b * c)
    
    xCenter = s
    yCenter = t
    radius = Sqr((x1 - xCenter) ^ 2 + (y1 - yCenter) ^ 2)
    
    '結果を表示
    Msg = "中心座標: (" & xCenter & ", " & yCenter & ")" & vbNewLine
    Msg = Msg & "半径: " & radius
    MsgBox Msg
    
    '円を描画
    With ActiveSheet.Shapes.AddShape(msoShapeOval, xCenter - radius, yCenter - radius, radius * 2, radius * 2)
        .Line.Weight = 1
    End With
    
End Sub


最新の画像もっと見る

コメントを投稿

ブログ作成者から承認されるまでコメントは反映されません。