ちょっと先を考えてのテストです。
VBAでベクトルを扱いたいのですが、それっぽいクラスが
無いんですよね・・。
他の言語の場合、手っ取り早くやりたい場合は複素数を使って
計算させているようなのですが、生憎VBAには無いです。
クラスを作るべきとは重々感じているのですが、ちょっとした
計算だけなので、こんな感じの値を2つ持った配列を、
二次元ベクトルとして代用します。(危険な事は知ってます・・・)
array(Xの値,Yの値)
で、それなりの関数を作りました。全て非破壊です。
'vba ベクトル2Dテスト Option Explicit Sub CATMain() 'ベクトル扱いして配列か確認 dump_msg "---" dump_msg is_vecter2d(Array(1, 0, 1)), "Array(1, 0, 1):" dump_msg is_vecter2d(Array(1)), "Array(1):" dump_msg is_vecter2d(Array(1, "a")), "Array(1, a):" dump_msg is_vecter2d(Array(1, 0)), "Array(1, 0):" '和 dump_msg "---" Dim v1, v2, s1 v1 = Array(1, 2) v2 = Array(3, 4) s1 = Array(1, "a") dump_array vec2_add(s1, v1), "vec2_add(s1, v1):" dump_array vec2_add(v1, v2), "vec2_add(v1, v2):" '差 dump_msg "---" dump_array vec2_diff(s1, v1), "vec2_diff(s1, v1):" dump_array vec2_diff(v1, v2), "vec2_diff(v1, v2):" '単位ベクトル dump_msg "---" dump_array vec2_normalize(s1), "vec2_normalize(s1):" dump_array vec2_normalize(Array(0, 0)), "vec2_normalize(zero):" dump_array vec2_normalize(v1), "vec2_normalize(v1):" 'スカラー倍 dump_msg "---" dump_array vec2_scaleBy(s1, 2), "vec2_scaleBy(s1,2):" dump_array vec2_scaleBy(v1, "a"), "vec2_scaleBy(v1,a):" dump_array vec2_scaleBy(v1, 2), "vec2_scaleBy(v1,2):" '内積 dump_msg "---" Dim axisX, axisY, v3 axisX = Array(1, 0) axisY = Array(0, 1) v3 = Array(1, 1) dump_msg vec2_dot(v1, s1), "vec2_dot(v1,s1) こいつは正しくない->:" dump_msg vec2_dot(v1, v2), "vec2_dot(v1,v2):" dump_msg vec2_dot(axisX, axisY), "vec2_dot(axisX, axisY):" dump_msg vec2_dot(axisX, axisX), "vec2_dot(axisX, axisX):" dump_msg vec2_dot(axisX, v3), "vec2_dot(axisX, v3):" '外積 dump_msg "---" dump_msg vec2_cross(v1, s1), "vec2_cross(v1,s1) こいつは正しくない->:" dump_msg vec2_cross(v1, v2), "vec2_cross(v1,v2):" dump_msg vec2_cross(axisX, axisY), "vec2_cross(axisX, axisY):" dump_msg vec2_cross(axisX, axisX), "vec2_cross(axisX, axisX):" dump_msg vec2_cross(axisX, v3), "vec2_cross(axisX, v3):" End Sub '外積 Function vec2_cross( _ ByVal v1 As Variant, _ ByVal v2 As Variant) _ As Double If Not (is_vecter2d(v1) And is_vecter2d(v2)) Then vec2_cross = Empty Exit Function End If vec2_cross = v1(0) * v2(0) - v1(1) * v2(1) End Function '内積 Function vec2_dot( _ ByVal v1 As Variant, _ ByVal v2 As Variant) _ As Double If Not (is_vecter2d(v1) And is_vecter2d(v2)) Then vec2_dot = Empty Exit Function End If vec2_dot = v1(0) * v2(0) + v1(1) * v2(1) End Function 'スカラー倍 Function vec2_scaleBy( _ ByVal v As Variant, _ ByVal ratio As Variant) _ As Variant If Not is_vecter2d(v) Then vec2_scaleBy = Empty Exit Function End If If Not IsNumeric(ratio) Then vec2_scaleBy = Empty Exit Function End If Dim length As Double length = Sqr(v(0) * v(0) + v(1) * v(0)) vec2_scaleBy = Array(v(0) * ratio, v(1) * ratio) End Function '単位ベクトル化 Function vec2_normalize( _ ByVal v As Variant) _ As Variant If Not is_vecter2d(v) Then vec2_normalize = Empty Exit Function End If Dim length As Double length = Sqr(v(0) * v(0) + v(1) * v(0)) If length <= 0 Then vec2_normalize = Empty Exit Function End If vec2_normalize = Array(v(0) / length, v(1) / length) End Function '差 Function vec2_diff( _ ByVal v1 As Variant, _ ByVal v2 As Variant) _ As Variant If Not (is_vecter2d(v1) And is_vecter2d(v2)) Then vec2_diff = Empty Exit Function End If vec2_diff = Array(v1(0) - v2(0), v1(1) - v2(1)) End Function '和 Function vec2_add( _ ByVal v1 As Variant, _ ByVal v2 As Variant) _ As Variant If Not (is_vecter2d(v1) And is_vecter2d(v2)) Then vec2_add = Empty Exit Function End If vec2_add = Array(v1(0) + v2(0), v1(1) + v2(1)) End Function 'ベクトル2Dとして扱える配列か? Private Function is_vecter2d( _ v As Variant) _ As Boolean Select Case True Case Not IsArray(v) is_vecter2d = False Case UBound(v) <> 1 is_vecter2d = False Case Not IsNumeric(v(0)) is_vecter2d = False Case Not IsNumeric(v(1)) is_vecter2d = False Case Else is_vecter2d = True End Select End Function '配列のダンプ Private Sub dump_array( _ ByVal ary As Variant, _ Optional msg As String) Select Case True Case IsEmpty(ary) Debug.Print msg & "** err ** - empty" Case Not IsArray(ary) Debug.Print msg & "** err ** - not array" Case Else Debug.Print msg & Join(ary, ",") End Select End Sub 'メッセージのダンプ Private Sub dump_msg( _ ByVal s As String, _ Optional msg As String) Debug.Print msg & s End Sub
実行結果はこんな感じです。
--- Array(1, 0, 1):False Array(1):False Array(1, a):False Array(1, 0):True --- vec2_add(s1, v1):** err ** - empty vec2_add(v1, v2):4,6 --- vec2_diff(s1, v1):** err ** - empty vec2_diff(v1, v2):-2,-2 --- vec2_normalize(s1):** err ** - empty vec2_normalize(zero):** err ** - empty vec2_normalize(v1):0.577350269189626,1.15470053837925 --- vec2_scaleBy(s1,2):** err ** - empty vec2_scaleBy(v1,a):** err ** - empty vec2_scaleBy(v1,2):2,4 --- vec2_dot(v1,s1) こいつは正しくない->:0 vec2_dot(v1,v2):11 vec2_dot(axisX, axisY):0 vec2_dot(axisX, axisX):1 vec2_dot(axisX, v3):1 --- vec2_cross(v1,s1) こいつは正しくない->:0 vec2_cross(v1,v2):-5 vec2_cross(axisX, axisY):0 vec2_cross(axisX, axisX):1 vec2_cross(axisX, v3):1
内外積に自信がない(今の所、使い道が思い付かない)