C#ATIA

↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)

2次元の点オブジェクト

こちらを進めていく上で限界を感じました。
全ての寸法に番号バルーンを付ける2 - C#ATIA

座標値を配列で管理する事に混乱してきましたので、
自作の2次元の点オブジェクトのクラスを作る事に。

幸い、Fusion360APIにPoint2Dオブジェクトがあり、
何のプロパティとメソッドがあれば良いのかが参考になります。
全てを実装するほどの力量が無いので、必要最低限の
機能+αぐらいにしてます。

こちらはクラスモジュールです。

'vba Pnt2D.cls

Option Explicit

Private x_ As Double
Private y_ As Double
Private Const TOLERANCE = 0.001

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 Pnt2D) As Vec2D
    Dim vec As Vec2D
    Set vec = New Vec2D
    
    vec.with_array Array(point.x - x_, point.y - y_)
    
    Set as_vector = vec
End Function


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


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

    Set clone = pnt
End Function


'ベクトル化
Public Function as_vector() As Vec2D
    Dim vec As Vec2D
    Set vec = New Vec2D
    
    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 Function str() As String
    str = x_ & "," & y_
End Function


'一致
Public Function is_equal_to(ByVal point As Pnt2D) As String
    is_equal_to = Me.distance_to(point) < TOLERANCE
End Function


'**メソッド-破壊**

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


'配列で設定
Public Sub with_array(ByVal ary As Variant)
    If Not is_point2d(ary) Then
        Err.Raise Number:=600, Description:="配列が不正です"
    End If

    x_ = ary(0)
    y_ = ary(1)
End Sub


'Pnt2Dとして扱える配列か?
Private Function is_point2d( _
    ary As Variant) _
    As Boolean

    Select Case True
        Case Not IsArray(ary)
            is_point2d = False
        Case UBound(ary) <> 1
            is_point2d = False
        Case Not IsNumeric(ary(0))
            is_point2d = False
        Case Not IsNumeric(ary(1))
            is_point2d = False
        Case Else
            is_point2d = True
    End Select

End Function

メソッドの関係上、自作2次元ベクトルクラス "Vec2D" が
出てきますが、そんなもんだぐらいに受け止めて頂ければ。


これを標準モジュールで作ったユニットテストで実行。

'vba

Option Explicit

Sub unit_test_Pnt2D()
    
    Dim p1 As Pnt2D
    Set p1 = New Pnt2D

    'with_array
    p1.with_array Array(1, 2)
    Debug.Assert "1,2" = p1.str()

    'as_array
    Debug.Assert is_equal_array(p1.as_array(), Array(1, 2))
    
    'clone
    Dim p2 As Pnt2D
    Set p2 = p1.clone()
    Debug.Assert p2.str() = p1.str()

    'prop x,y
    p2.x = 1
    p2.y = 4
    Debug.Assert is_equal_array(p2.as_array(), Array(1, 4))

    'distance_to
    Debug.Assert 2 = p1.distance_to(p2)

    'as_vector
    Dim vec As Vec2D
    Set vec = p1.as_vector()
    Debug.Assert is_equal_array(vec.as_array(), p1.as_array())

    'translate_by
    vec.scale_by 2
    Debug.Assert is_equal_array(vec.as_array(), Array(2, 4))
    
    p1.translate_by vec
    Debug.Assert is_equal_array(p1.as_array(), Array(3, 6))
    
    'is_equal_to
    p2.with_array Array(3, 6)
    Debug.Assert p1.is_equal_to(p2)

    MsgBox "Done"

End Sub


'配列が一致しているか?
Private Function is_equal_array( _
    ByVal ary1 As Variant, _
    ByVal ary2 As Variant) _
    As Boolean

    is_equal_array = True
    
    Select Case False
        Case IsArray(ary1)
            is_equal_array = False
            Exit Function
        Case IsArray(ary2)
            is_equal_array = False
            Exit Function
        Case UBound(ary1) = UBound(ary2)
            is_equal_array = False
            Exit Function
    End Select

    Dim i As Long
    For i = 0 To UBound(ary1)
        If ary1(i) <> ary2(i) Then
            is_equal_array = False
            Exit Function
        End If
    Next

End Function

取りあえず、テストした範囲ではOKです。

まさかこんなクラスまで作る様になるとは思いませんでした。
取りあえず、2次元ベクタークラスと2次元バウンダリボックスの
亜種が欲しい・・・。