一次関数のクラス - Infomentのブログ～Excel VBA奮闘記～

オートシェイプなどを正確に描画しようと思ったら、昔習った数学の知識を、地底深くから掘り起こす必要があります。例えば昨日のPowerPointのマクロでは、以下の座標を求める必要がありました。

二点間を結ぶ直線Ａと、別の二点間を結ぶ直線Ｂの交点座標Ｏ
座標Ｏを原点とする半径ｒの円と、直線Ａの共有点（２箇所）

最初は、直線ＡとＢが傾いていても関係なく、一般式を作成して対応しようとしたのですが、数式が複雑化したため断念しました。
その結果、昨日のマクロは

理想気体の状態方程式

などのように、ある特殊な条件下でのみ成立するものとなってしまいました。
※この場合は、二本の線が水平線と垂直線であること。

そこで、今後のオートシェイプ操作に備えて、数学的な幾つかのパラメータを取得するクラスモジュールを準備しておくことにしました。
※既に世の中にあるかもしれませんが、自身の練習も兼ねて。

まずは、直線ＡとＢの交点座標を求めてみました。

［クラスモジュール］名前：MathematicalFormulaClass

Option Explicit

Public x1 As Double, y1 As Double
Public x2 As Double, y2 As Double
Public x3 As Double, y3 As Double
Public x4 As Double, y4 As Double
Public x5 As Double, y5 As Double
Public x6 As Double, y6 As Double

Public Function GetSlope(x As Double, y As Double, u As Double, v As Double) As Double
    GetSlope = (y - v) / (x - u)
End Function

Public Function GetIntercept(a As Double, x As Double, y As Double) As Double
    GetIntercept = y - a * x
End Function

Public Property Get a1() As Double
    a1 = GetSlope(x1, y1, x2, y2)
End Property

Public Property Get a2() As Double
    a2 = GetSlope(x3, y3, x4, y4)
End Property

Public Property Get b1() As Double
    b1 = GetIntercept(a1, x1, y1)
End Property

Public Property Get b2() As Double
    b2 = GetIntercept(a2, x3, y3)
End Property

Public Property Get GetIntersect_x() As Double
    GetIntersect_x = (b2 - b1) / (a1 - a2)
End Property

Public Property Get GetIntersect_y() As Double
    GetIntersect_y = a1 * GetIntersect_x + b1
End Property

いずれ、３つの点からなる円ＡとＢの共有点を求める場合があるかもしれないので、座標は６つ準備しています。

結果を、こちらのサンプルで確認しました。
f:id:Infoment:20180909151350p:plain

Option Explicit

Sub CalcTest()
    Dim MFC As MathematicalFormulaClass
    Set MFC = New MathematicalFormulaClass
        With MFC
            .x1 = 3:  .y1 = 6
            .x2 = -3: .y2 = -6
            .x3 = -4: .y3 = 9
            .x4 = 4:  .y4 = -7
        End With
        
    Dim x0 As Double
        x0 = MFC.GetIntersect_x
    Dim y0 As Double
        y0 = MFC.GetIntersect_y
        
        Debug.Print "X座標：" & x0
        Debug.Print "Y座標：" & y0
End Sub