2008年7月11日金曜日

3点を通過する円弧の中心座標(VBA)

平面上で3点を通過する円弧の中心座標を求めるプログラム例です。連立方程式の解法で行列演算を利用しているので、応用が利くと思います。

Sub テスト()

Dim A(1 To 2, 1 To 2) As Double
Dim B(1 To 2, 1 To 1) As Double
Dim I As Integer, X1 As Double, X2 As Double, X3 As Double
Dim Y1 As Double, Y2 As Double, Y3 As Double

With Worksheets("sheet11")
I = 1
Do
X1 = .Cells(I, 1)
X2 = .Cells(I + 1, 1)
X3 = .Cells(I + 2, 1)
Y1 = .Cells(I, 2)
Y2 = .Cells(I + 1, 2)
Y3 = .Cells(I + 2, 2)

A(1, 1) = 2 * (X1 - X2)
A(1, 2) = 2 * (Y1 - Y2)
A(2, 1) = 2 * (X1 - X3)
A(2, 2) = 2 * (Y1 - Y3)
B(1, 1) = (X1 ^ 2 - X2 ^ 2) + (Y1 ^ 2 - Y2 ^ 2)
B(2, 1) = (X1 ^ 2 - X3 ^ 2) + (Y1 ^ 2 - Y3 ^ 2)

.Cells(I, 6) = EquationAnswer(A, B)(1, 1)
.Cells(I, 7) = EquationAnswer(A, B)(2, 1)


I = I + 2
Loop Until I = 1101
End With
End Sub


Function EquationAnswer(ByVal A As Variant, ByVal B As Variant) As Variant
On Error GoTo ErrHndl
With WorksheetFunction
EquationAnswer = .MMult(.MInverse(A), B)
End With
On Error GoTo 0
Exit Function
ErrHndl:
EquationAnswer = CVErr(xlErrValue)
On Error GoTo 0
End Function

後記:尚、別の方法は下記URLに記載してあります。
http://m-sudo.blogspot.com/2009/08/blog-post_3480.html

4 件のコメント:

匿名 さんのコメント...

こんばんは。
関数EquationAnswerを呼び出す際に
()()となっていますが、これはどういう
意味になるのでしょうか?
受け側の型をVariantにしておけば配列が
渡せるというのは知っているのですが、
引数が2回?の構文の書き方のヘルプを
見つける事が出来ませんでしたので・・・。

m-sudo さんのコメント...

匿名さん、こんばんは。
すっかり忘却のかなたのブログで失礼します。下記の通りに素直にご理解頂けないでしょうか。
EquationAnswer = .MMult(.MInverse(A), B)
このコード(ブログ全体の)は連続する点列(X1,Y1) (X2,Y2) (X3,Y3)…(X1101,Y1101)を円弧成分で繋げてみようとして作成したコードです。スプラインを円弧の連続で代替する目的で作成したものです。現在コードの流れを検討しようにも当方、思い出せないのが現実です。ご容赦ください。
m-sudo

m-sudo さんのコメント...

連続するコメントで失礼します。応用の参考例として・・・
下記URLを参照ください。
http://m-sudo.blogspot.com/2008/07/blog-post_10.html

匿名 さんのコメント...

m-sudoさん
コメント頂きありがとうございます。
また、お礼が遅れて申し訳ありません。
EquationAnswer = .MMult(.MInverse(A), B)の箇所は、MMult関数またはMInverse関数によって得られた配列を
返しているという事は理解出来たのですが、
呼びだし側の「EquationAnswer(A, B)(1, 1)」となっている箇所の後ろのカッコがどういった意味になるのかが分からなかったので質問させて頂きました。
後ろのカッコは気にせずに、この場合は「A配列とB配列を引数として渡す」という考え方で宜しいんですかね?
もし思い出された場合、教えて頂ければ助かります。