| 名称 | ・・・・・・・ |
ベクトル関係サンプルセット 概略 |
| ルーチン名 | ・・・・・・・ |
addVec3-----------3次元ベクトルの加法(sub_set03-001) |
| スクリプトNo | ・・・・・・・ | sub_set 01-003 |
| DownLoad | ・・・・・・・ | scriptSet03.lzh(ANSI版) scriptSet03_u.lzh(UTF-8版) (右クリックのコンテクストメニューでダウンロードできます。windowsのみ) 関連するサブルーチンが全て含まれています。 圧縮されていますので解凍してreadme.htmlの説明を参考にして下さい。 |
| 概略 | ・・・・・・・ |
Shadeで座標を扱う時に便利と思われるベクトルに関するスクリプトを集めました。 |
| 使用前提 | ・・・・・・・ |
test()サブルーチン内のサンプルを実行する時はShadeで「新規作成」してから実行してください。 |
| 依存関係 | ・・・・・・・ |
上記のルーチン名をクリックすると詳細情報の中に記述があります。 |
| 引数説明 | ・・・・・・・ |
上記のルーチン名をクリックすると詳細情報の中に記述があります。 |
| 戻り値説明 | ・・・・・・・ |
同上 |
| 変数説明 | ・・・・・・・ |
同上 |
| 全体の説明 | ・・・・・・・ |
前半部分はサブルーチンの機能の確認テストtest()です。 サブルーチンセット本体は後ろにあります。 全体の記述の決まりとして普通の「ベクトル」はvec、「位置ベクトル」はpos、「方向余弦（単位ベクトル）」はeVecで表わすようにしています。各要素は 0：x, 1：y, 2：z 方向を意味しています。 セットのサブルーチンの中にはセットの中の別のサブルーチンを使用しているケースがあるので依存関係を確認してください。 ちなみにtest()サブルーチンのテスト描画では、普通のベクトルは黄色、位置ベクトルは緑、面はシアン，戻り値(結果)を描画したものが赤となっています。 |
| スクリプト | ||
option explicit
XShade.message"===================start========================"
dim Green(2),Yellow(2),Cyan(2),Red(2)
call test()
XShade.message"===================finish======================="
sub test()
'***テストの為の初期設定***
dim pos0(2) '原点
dim pos1(2),pos2(2),pos3(2),pos4(2) '各位置ベクトル
dim vec0(2),vec1(2),vec2(2),vec3(2) 'ベクトル
dim j
'色の設定
Green(0)=0:Green(1)=255:Green(2)=100
Yellow(0)=255:Yellow(1)=255:Yellow(2)=0
Cyan(0)=0:Cyan(1)=255:Cyan(2)=255
Red(0)=255:Red(1)=0:Red(2)=0
'テスト用の座標値設定
pos0(0)=0:pos0(1)=0:pos0(2)=0 '原点の各方向成分
pos1(0)=300:pos1(1)=400:pos1(2)=0 'pos1の各方向成分
pos2(0)=100:pos2(1)=100:pos2(2)=-200 'pos2の各方向成分
pos3(0)=200:pos3(1)=200:pos3(2)=300 'pos3の各方向成分
pos4(0)=950:pos4(1)=800:pos4(2)=100 'pos4の各方向成分
vec0(0)=1000:vec0(1)=1200:vec0(2)=-500 'vec0の各方向成分
vec1(0)=200:vec1(1)=-400 :vec1(2)=400 'vec1の各方向成分
vec2(0)=500 :vec2(1)=-750:vec2(2)=450 'vec2の各方向成分
vec3(0)=300 :vec3(1)=200 :vec3(2)=-400
'**************テストはここから***************
'testしたい項目のコメントアウトを解除して試してください。
'ベクトルの加法のテスト
' dim vecResult
' vecResult=addVec3(vec1,vec2)
' for j=0 to 2
' XShade.Message"j="&j&" ans="&vecResult(j)
' next
' drawVec pos0,vec1
' drawVec pos0,vec2
' drawVec pos0,vecResult
' ColorSet Red
' XShade.ObjectName="和"
' XShade.SelectParent 1
'ベクトルの減法のテスト
' dim vecResult
' vecResult=subVec3(vec2,vec1)
' for j=0 to 2
' XShade.Message"j="&j&" ans="&vecResult(j)
' next
' drawVec pos0,vec1
' drawVec pos0,vec2
' drawVec pos0,vecResult
' ColorSet Red
' XShade.ObjectName="差"
' XShade.SelectParent 1
'ベクトルの実数倍のテスト
' dim vecResult,real
' real=5
' vecResult=realVec3(real,vec1)
' for j=0 to 2
' XShade.Message"j="&j&" ans="&vecResult(j)
' next
' drawVec pos0,vec1
' drawVec pos0,vecResult
' ColorSet Red
' XShade.ObjectName="整数倍（"&real&"倍）"
' XShade.SelectParent 1
'ベクトルの内積のテスト
'描画されるのは元のベクトルだけです。
' dim Result
' Result=innerProduct3(vec1,vec2)
' XShade.message"innerProduct="&Result
' drawVec pos0,vec1
' drawVec pos0,vec2
' XShade.SelectParent 1
'ベクトルの外積のテスト
' dim vecResult
' vecResult=CrossProduct3(vec1,vec2)
' for j=0 to 2
' XShade.Message"j="&j&" ans="&vecResult(j)
' next
' drawVec pos0,vec1
' drawVec pos0,vec2
' drawVec pos0,vecResult
' ColorSet Red
' XShade.ObjectName="外積"
' XShade.SelectParent 1
'2点の距離計算のテスト
'描画されるのは元のベクトルだけです。
' dim Result
' Result=PointsDistance(pos1,pos2)
' XShade.Message"Distance="&Result
' drawPos pos1
' drawPos pos2
' XShade.SelectParent 1
'2点の単位ベクトルのテスト
'(注)単位ベクトルは非常に小さいので拡大してみてください。
' dim VecResult(2)
' if GetEVec(pos1,pos2,vecResult) then
' for j=0 to 2
' XShade.Message"j="&j&" ans="&vecResult(j)
' next
' drawPos pos1
' drawPos pos2
' drawVec pos1,subVec3(pos2,pos1)
' XShade.ObjectName="2点指定ベクトル"
' drawVec pos0,vecResult
' ColorSet Red
' XShade.ObjectName="単位ベクトル"
' else
' XShade.Message"pos1とpos2は同位置です。"
' end if
' XShade.SelectParent 1
'ベクトルの正規化のテスト
'(注)正規化されたベクトルは非常に小さいので拡大してみてください。
' dim vecResult
' vecResult=normVec3(vec1)
' if IsArray(vecResult) then
' for j=0 to 2
' XShade.Message"j="&j&" ans="&vecResult(j)
' next
' drawVec pos0,vec1
' XShade.ObjectName="元のベクトル"
' drawVec pos0,vecResult
' ColorSet Red
' XShade.ObjectName="単位ベクトル"
' else
' XShade.Message"vec1には大きさがありません"
' end if
' XShade.SelectParent 1
'2直線のなす角のテスト
'描画されるのは元のベクトルだけです。
' dim Angle,eVec1,eVec2
' eVec1=normVec3(vec1)
' if Not IsArray(eVec1) then exit sub
' eVec2=normVec3(vec2)
' if Not IsArray(eVec2) then exit sub
' Angle=LinesAlph(eVec1,eVec2)
' drawVec pos0,vec1
' drawVec pos0,vec2
' XShade.Message "Angle(rad)="&Angle
' Angle=Angle*360/(2*XShade.PI)
' XShade.Message "Angle(degree)="&Angle
' XShade.SelectParent 1
'2直線の交差点のテスト
'(注)交差するのは特別な場合なので与えるデータを変更する時は注意が必要
' dim vecResult,eVec1,eVec3
' eVec1=normVec3(vec1)
' eVec3=normVec3(vec3)
' vecResult=LinesPtCross(eVec1,eVec3,pos1,pos3)
' if IsArray(vecResult) then
' for j=0 to 2
' XShade.Message"j="&j&" ans="&vecResult(j)
' next
' drawVec pos1,vec1
' drawVec pos3,vec3
' drawPos vecResult
' ColorSet Red
' XShade.ObjectName="交差点の位置ベクトル"
' else
' XShade.Message"交差しません"
' end if
' XShade.SelectParent 1
'
'面と直線の交点のテスト
' dim vecResult,eVec,l
' l=1000 '描画する直線の長さ
' eVec=normVec3(vec1)
' vecResult=LinePlanePtCross(pos1,eVec,pos2,pos3,pos4)
' if IsArray(vecResult) then
' for j=0 to 2
' XShade.Message"j="&j&" ans="&vecResult(j)
' next
' drawPlane pos2,pos3,pos4
' drawVec pos1,realVec3(l,eVec)
' drawPos vecResult
' ColorSet Red
' XShade.ObjectName="交差点の位置ベクトル"
' else
' XShade.Message"交差しません"
' end if
' XShade.SelectParent 1
End sub
'==========================ここからベクトル関係セットです。============================
'---ベクトルの加法(3次元ベクトル)-----------------------
function addVec3(vec1,vec2)
dim newVec(2),j
for j=0 to 2
newVec(j)=vec1(j)+vec2(j)
next
addVec3=newVec
end function
'---ベクトルの減法(3次元ベクトル)-----------------------
function subVec3(vec1,vec2)
dim newVec(2),j
for j=0 to 2
newVec(j)=vec1(j)-vec2(j)
next
subVec3=newVec
end function
'---ベクトルの実数倍(3次元ベクトル)---------------------
function realVec3(real,vec)
dim newVec(2),j
for j=0 to 2
newVec(j)=real*vec(j)
next
realVec3=newVec
end function
'---内積を計算する(3次元ベクトル)-----------------------
function InnerProduct3(vec1,vec2)
dim InnerPro
InnerPro=vec1(0)*vec2(0)+vec1(1)*vec2(1)+vec1(2)*vec2(2)
InnerProduct3=InnerPro
end function
'---外積を計算する(3次元ベクトル)-----------------------
function CrossProduct3(vec1,vec2)
dim CrossPro(2)
CrossPro(0)=vec1(1)*vec2(2)-vec1(2)*vec2(1)
CrossPro(1)=vec1(2)*vec2(0)-vec1(0)*vec2(2)
CrossPro(2)=vec1(0)*vec2(1)-vec1(1)*vec2(0)
CrossProduct3=CrossPro
end function
'---与えられた2点の座標データから距離を計算する。-------
function PointsDistance(pos1,pos2)
dim D,j
D=0
for j=0 to 2
D=D+(pos2(j)-pos1(j))^2
next
PointsDistance=D^(1/2)
end function
'---与えられた2点の座標データから単位ベクトルを計算する
function GetEVec(pos1,pos2,eVec)
dim D,delta(2),j,clearance
D=0
for j=0 to 2
delta(j)=pos2(j)-pos1(j)
D=D+delta(j)^2
next
if D=0.0 then
GetEVec=false
Exit Function
end if
D=D^(1/2)
for j=0 to 2
eVec(j)=delta(j)/D
next
GetEVec=true
end function
'---ベクトルの正規化。----------------------------------
function normVec3(vec)
dim D,j,newVec(2)
D=0
for j=0 to 2
D=D+vec(j)^2
next
D=D^(1/2)
if D=0.0 then
normVec3=false
exit function
end if
for j=0 to 2
newVec(j)=Vec(j)/D
next
normVec3=newVec
end function
'---2直線のなす角度-------------------------------------
function LinesAlph(eVec1,eVec2)
Dim Alpha
Alpha=XShade.Acos(eVec1(0)*eVec2(0)+eVec1(1)*eVec2(1)+eVec1(2)*eVec2(2))
LinesAlph=Alpha
end function
'---2直線の交差点（2点が交差するときのみ存在)-----------
Function LinesPtCross(eVec1,eVec2,Pos1,Pos2)
dim S1,S2,Q,dif,t
if Not JudgeLinesCross(eVec1,eVec2,Pos1,Pos2) then
LinesPtCross=false
exit function
end if
dif=subVec3(Pos2,Pos1)
Q=innerProduct3(eVec1,eVec2)
S1=innerProduct3(eVec1,dif)
S2=-(innerProduct3(eVec2,Dif))
t=(S2*Q+S1)/(1-Q^2)
LinesPtCross=addVec3(Pos1,realVec3(t,eVec1))
End Function
'---2直線が一点で交差する条件（ﾌﾞｰﾘｱﾝによる判定）
'(注)変換の繰り返しなどで元データの誤差が大いと判定漏れの可能性あり
' 有効桁数と相談してclearanceを決めてください。
function JudgeLinesCross(eVec1,eVec2,pos1,pos2)
Dim judge,Vec,clearance,j,svec
judge=true
clearance=0.00001
vec=crossProduct3(eVec1,eVec2)
for j=0 to 2
svec=svec+abs(vec(j))
next
if svec<clearance then judge=false
if abs(innerProduct3(vec,subVec3(pos2,pos1)))>clearance then judge=false
judgeLinesCross=judge
end function
'---平面と直線の交点（面と線が交差する時のみ存在)-------
'(注)変換の繰り返しなどで元データの誤差が大いと判定漏れの可能性あり
' 有効桁数と相談してclearanceを決めてください。
Function LinePlanePtCross(Lpos,LeVec,Ppos1,Ppos2,Ppos3)
dim Nvec,t,clearance
clearance=0.00001
Nvec=normVec3(CrossProduct3(subVec3(Ppos2,Ppos1),subVec3(Ppos3,Ppos1)))
if Not IsArray(Nvec) then
LinePlanePtCross=false
exit function
end if
if abs(innerProduct3(NVec,LeVec))<clearance then
LinePlanePtCross=false
exit function
end if
t=-innerProduct3(Nvec,subVec3(Lpos,Ppos1))/innerProduct3(NVec,LeVec)
LinePlanePtCross=addVec3(Lpos,realVec3(t,LeVec))
end function
'***Test描画用（ベクトル関係ありません、テスト結果の確認用です)***
sub DrawPlane(pos1,pos2,pos3)
XShade.StartPolygon(1)
XShade.appendPoint pos1(0),pos1(1),pos1(2)
XShade.appendPoint pos2(0),pos2(1),pos2(2)
XShade.appendPoint pos3(0),pos3(1),pos3(2)
XShade.finishPolygon()
XShade.ObjectName="面"
ColorSet Cyan
end sub
sub DrawVec(pos,vec)
dim NP
NP=addVec3(pos,vec)
XShade.StartPolygon(0)
XShade.appendPoint pos(0),pos(1),pos(2)
XShade.appendPoint NP(0),NP(1),NP(2)
XShade.finishPolygon()
XShade.ObjectName="ベクトル"
ColorSet Yellow
end sub
sub DrawPos(pos)
XShade.StartPolygon(0)
XShade.appendPoint 0,0,0
XShade.appendPoint pos(0),pos(1),pos(2)
XShade.finishPolygon()
XShade.ObjectName="位置ベクトル"
ColorSet Green
end sub
sub ColorSet(colorName)
XShade.BaseColor(0)=colorName(0)
XShade.BaseColor(1)=colorName(1)
XShade.BaseColor(2)=colorName(2)
end sub
|
||
| 使用例 | ||
個々のサブルーチンの詳細を見てください。 |
||