自作2Dの点とベクトル

前にも作ったのですが、やっぱり必要性を感じるので少し育てました。

catiaのクラス名とバッティングする為、アンダーバーを入れることにしました。

点クラスです。トレランス付きの一致を追加しています。

'vba Point_2D

Option Explicit

Private x_ As Double
Private y_ As Double


Private Sub Class_Initialize()
    x_ = 0
    y_ = 0
End Sub


Private Sub Class_Terminate()
    
End Sub


'**プロパティ**
Public Property Get x() As Double
    x = x_
End Property


Public Property Let x(ByVal value As Double)
    x_ = value
End Property


Public Property Get y() As Double
    y = y_
End Property


Public Property Let y(ByVal value As Double)
    y_ = value
End Property


'**メソッド**
'2点間ベクトル
Public Function vector_to(ByVal point As Point_2D) As Vector_2D
    Dim vec As Vector_2D
    Set vec = New Vector_2D
    
    vec.with_array Array(point.x - x_, point.y - y_)
    
    Set as_vector = vec
End Function


'2点間距離
Public Function distance_to(ByVal point As Point_2D) As Double
    distance_to = Sqr((point.x - x_) ^ 2 + (point.y - y_) ^ 2)
End Function


'クローン
Public Function clone() As Point_2D
    Dim pnt As Point_2D
    Set pnt = New Point_2D
    pnt.with_array (Array(x_, y_))

    Set clone = pnt
End Function


'ベクトル化
Public Function as_vector() As Vector_2D
    Dim vec As Vector_2D
    Set vec = New Vector_2D
    
    vec.with_array Array(x_, y_)
    
    Set as_vector = vec
End Function


'配列化
Public Function as_array() As Variant
    as_array = Array(x_, y_)
End Function


'移動
Public Sub translate_by(ByVal vector As Vector_2D)
    x_ = x_ + vector.x
    y_ = y_ + vector.y
End Sub


'配列で設定
Public Sub with_array(ByVal ary As Variant)
    x_ = ary(0)
    y_ = ary(1)
End Sub


'文字
Public Function str() As String
    str = x_ & "," & y_
End Function


'一致か？
Public Function is_equal( _
    ByVal pnt As Point_2D, _
    Optional ByVal tolerance As Double = 0.001) As Boolean

    is_equal = Me.distance_to(pnt) < tolerance
End Function

今回は要らないような気もしますが、ベクトルです。
点同様に一致と長さのプロパティを追加です。

'vba Vector_2D

Option Explicit

Private x_ As Double
Private y_ As Double


Private Sub Class_Initialize()
    x_ = 0
    y_ = 0
End Sub


Private Sub Class_Terminate()
    
End Sub


'**プロパティ**
Public Property Get x() As Double
    x = x_
End Property


Public Property Let x(ByVal value As Double)
    x_ = value
End Property


Public Property Get y() As Double
    y = y_
End Property


Public Property Let y(ByVal value As Double)
    y_ = value
End Property


Public Property Get length() As Double
    length = Sqr(x_ * x_ + y_ * y_)
End Property


'**メソッド**

'クローン
Public Function clone() As Point_2D
    Dim vec As Vector_2D
    Set vec = New Vector_2D
    
    vec.with_array Array(x_, y_)
    
    Set clone = vec
End Function


'ポイント化
Public Function as_point() As Point_2D
    Dim pnt As Point_2D
    Set pnt = New Point_2D
    
    pnt.with_array Array(x_, y_)
    
    Set as_point = pnt
End Function


'配列化
Public Function as_array() As Variant
    as_array = Array(x_, y_)
End Function


'外積
Public Function cross(ByVal vector As Vector_2D) As Double
    cross = x_ * vector.x - y_ * vector.y
End Function


'内積
Public Function dot(ByVal vector As Vector_2D) As Double
    dot = x_ * vector.x + y_ * vector.y
End Function


'差
Public Sub subtract(ByVal vector As Vector_2D)
    x_ = x_ - vector.x
    y_ = y_ - vector.y
End Sub


'和
Public Sub add(ByVal vector As Vector_2D)
    x_ = x_ + vector.x
    y_ = y_ + vector.y
End Sub


'スカラー倍
Public Sub scale_by(ByVal ratio As Double)
    x_ = x_ * ratio
    y_ = y_ * ratio
End Sub


'単位化
Public Function normalize() As Boolean
    Dim length As Double
    length = Me.length
    
    If length <= 0 Then
        normalize = False
        Exit Function
    End If

    x_ = x_ / length
    y_ = y_ / length

    normalize = True
End Function


'配列で設定
Public Sub with_array(ByVal ary As Variant)
    x_ = ary(0)
    y_ = ary(1)
End Sub


'文字
Public Function str() As String
    str = x_ & "," & y_
End Function


'一致か？
Public Function is_equal( _
    ByVal vec As Vector_2D, _
    Optional ByVal tolerance As Double = 0.001) As Boolean

    is_equal = Me.as_point().distance_to( _
        vec.as_point()) < tolerance
End Function

主に新たな機能についての単体テスト

'vba 

Sub unit_test()

    Dim p1 As Point_2D
    Set p1 = New Point_2D
    p1.with_array Array(1, 2)

    Dim p2 As Point_2D
    Set p2 = New Point_2D

    p2.with_array Array(2, 2)
    Debug.Assert p1.is_equal(p2) = False

    p2.with_array Array(1, 2)
    Debug.Assert p1.is_equal(p2) = True

    p2.with_array Array(1.0001, 2)
    Debug.Assert p1.is_equal(p2, 0.01) = True


    Dim vec1 As Vector_2D
    Set vec1 = New Vector_2D
    
    vec1.with_array (Array(2, 0))
    Debug.Assert vec1.length = 2

    vec1.with_array (Array(2, 1))
    Debug.Assert Not vec1.length = 2

    vec1.normalize
    Debug.Assert vec1.length = 1

    Dim vec2 As Vector_2D
    Set vec2 = New Vector_2D
    
    vec1.with_array (Array(2, 0))
    vec2.with_array (Array(2, 0))
    Debug.Assert vec1.is_equal(vec2)

    vec2.scale_by -1
    Debug.Assert vec1.is_equal(vec2) = False

    Debug.Print "OK"

End Sub

OKです。