15.座標による交点計算 (F-BASIC)
lprint type"dc"
'-----------交点計算-------------
defdbl D-H,L,P-Y:defstr N,K:defint a,I,J,c
PI=3.141592653589793#:EE=0.0000000001#
RA=206264.806471#:RAA=180#/PI:RRA=PI/180#
dim NN$(50),N2$(50),XR(50),YR(50),XL(50),YL(50),SS(20),S(20)
def fnRAA(D)=(fix(D)+fix*1/36)/RAA:'-----度分秒からラジアンへ------
def fnDEG(T)=fix(T)+fix(((T)-fix(T))*100#)/60#+*2/0.36#:'-----度分秒から度へ------
def fnDMS(T)=fix(T)+fix*3*60#)/100#+*4*60#-fix*5*60#))*0.006#:'-----度から度分秒へ------
AN1$=" －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－"
'-----------------
*SENTAKU1
cls:locate 20,3:print"計算の項目を選択して下さい。"
locate 25,6:print"四点座標による計算・・・・・・・・・１"
locate 25,8:print"三点座標と一方向による計算・・・・・２"
locate 25,10:print"二点座標と二方向による計算・・・・・３"
locate 25,12:print"直線と円による計算・・・・・・・・・４"
locate 25,14:print"円と円による計算・・・・・・・・・・５"
locate 25,16:print"作業終了・・・・・・・・・・・・・・６"
locate 30,20:input"番号を選択して下さい。 ";JO
if JO<1 or JO>6 then *SENTAKU1
on JO goto *4TEN,*3TEN,*2TEN,*EN1,*EN2,*ENDD1
'
goto *SENTAKU1
'
*4TEN:'-----四点座標による計算-----
'-----作業メニュ－-----
gosub *MENU1
on JJA goto *DATRIN1,*SYUSEI1,*KEISAN1,*ENDD1
'
*DATRIN1:'-------デ－タ 入力-------
cls:locate 20,1:print "-----------デ－タの入力-----------"
locate 20,4:input "点名1 ";K$(1)
locate 20,5:input " 座標 X= ";X(1)
locate 20,6:input " 座標 Y= ";Y(1)
locate 20,8:input "点名2 ";K$(2)
locate 20,9:input " 座標 X= ";X(2)
locate 20,10:input " 座標 Y= ";Y(2)
locate 20,11:input " 拡幅長 W1= 右＋ 左－";W1
locate 20,13:input "点名3 ";K$(3)
locate 20,14:input " 座標 X= ";X(3)
locate 20,15:input " 座標 Y= ";Y(3)
locate 20,17:input "点名4 ";K$(4)
locate 20,18:input " 座標 X= ";X(4)
locate 20,19:input " 座標 Y= ";Y(4)
locate 20,20:input " 拡幅長 W2= 右＋ 左－ ";W2
locate 20,22:input " 交点名 = ";K1$
'
goto *4TEN
'
*SYUSEI1:'--------デ－タ－の修正-----------
cls:locate 20,3:print "--------デ－タ－の修正-----------"
locate 20,6:print "座標値の修正・・・１"
locate 20,8:print "拡幅長 Ｗ１＝・・２"
locate 20,10:print "拡幅長 Ｗ２＝・・３"
locate 20,12:print "交点名・・・・・・４"
locate 20,14:print "次の修正点・・・・５"
locate 20,16:print "終 了・・・・・・６"
'
*40:locate 35,19:input "番号を指定して下さい。";AA
if AA<1 or AA>6 then *40
on AA goto *63,*64,*65,*66,*SYUSEI1,*4TEN
'
*63:cls:locate 20,6:input "何番目の座標か ";J1
locate 20,8:input "点名 ";K$(J1)
locate 20,10:input "座標 Ｘ＝ ";X(J1)
locate 20,12:input "座標 Ｙ＝ ";Y(J1):goto *SYUSEI1
*64:CLS:locate 20,12:input " 拡幅長 W1= 右＋ 左－ ";W1:goto *SYUSEI1
*65:CLS:locate 20,12:input " 拡幅長 W2= 右＋ 左－ ";W2:goto *SYUSEI1
*66:CLS:locate 20,12:input " 交点名 = ";K1$:goto *SYUSEI1
'
*KEISAN1:'------計 算 中---------
cls:locate 30,12:print "計 算 中"
DX=X(2)-X(1):DY=Y(2)-Y(1):gosub *STSUB:T1=tan(TD):S0=SS:TN=TD:gosub *7200:TA0=TN
H1=TD+PI/2#:X1=X(1)+cos(H1)*W1:Y1=Y(1)+sin(H1)*W1
DX=X(4)-X(3):DY=Y(4)-Y(3):gosub *STSUB:T2=tan(TD):SS0=SS:TN=TD:gosub *7200:TB0=TN
H2=TD+PI/2#:X2=X(3)+cos(H2)*W2:Y2=Y(3)+sin(H2)*W2
gosub *KOUTENSUB
'
'------------計算書作成------------
CLS:locate 30,12:print "印 刷 中"
lprint:lprint:lprint:lprint:lprint:lprint:lprint:lprint tab(30)"四 点 座 標 に よ る 交 点 計 算 書":lprint:lprint:lprint:lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 右＋ 左－ ";K$(1),1,X(1),1,Y(1):lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 W1=###.###";K$(2),2,X(2),2,Y(2),W1:lprint
lprint using " & & X##=#######.#### Y##=#######.####";K$(3),3,X(3),3,Y(3):lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 W2=###.###";K$(4),4,X(4),4,Y(4),W2:lprint
lprint AN1$:lprint
lprint using " 交点 & & X=#######.##### Y=#######.#####";K1$,XX,YY:lprint
lprint AN1$:lprint
lprint using " 全体距離１ S1=####.##### 方向角１ T1=####.###### S=#####.#####";S0,TA0,SS1:lprint
lprint using " 全体距離２ S2=####.##### 方向角２ T2=####.###### S=#####.#####";SS0,TB0,SS2:lprint
lprint chr$(12);
'
goto *4TEN
'
*3TEN:'-----------三点座標と一方向による交点計算------------
locate 20,5:print "＊＊＊作業メニュ－ ＊＊＊"
gosub *MENU1
on JJA goto *DATRIN2,*SYUSEI2,*KEISAN2,*ENDD1
'
*DATRIN2:'-------デ－タ 入力-------
cls:locate 20,2:print "-----------デ－タの入力-----------"
locate 20,5:input "点名1 ";K$(1)
locate 20,6:input " 座標 X= ";X(1)
locate 20,7:input " 座標 Y= ";Y(1)
locate 20,9:input "点名2 ";K$(2)
locate 20,10:input " 座標 X= ";X(2)
locate 20,11:input " 座標 Y= ";Y(2)
locate 20,12:input " 拡幅長 W1= 右＋ 左－ ";W1
locate 20,14:input "点名3 ";K$(3)
locate 20,15:input " 座標 X= ";X(3)
locate 20,16:input " 座標 Y= ";Y(3)
locate 20,17:input " 方向角 T3= ";T(3)
locate 20,18:input " 拡幅長 W2= 右＋ 左－ ";W2
locate 20,21:input " 交点名 = ";K1$
'
goto *3TEN
'
*SYUSEI2:'--------デ－タ－の修正-----------
cls:locate 20,1:print "--------デ－タ－の修正-----------"
locate 30,6:print "座標値の修正・・・１"
locate 20,8:print "拡幅長 Ｗ１＝・・２"
locate 20,10:print "拡幅長 Ｗ２＝・・３"
locate 20,12:print "方向角 Ｔ０＝・・４"
locate 20,14:print "交点名・・・・・・５"
locate 20,16:print "次の修正点・・・・６"
locate 20,18:print "終 了・・・・・・７"
'
*41:locate 35,21:input "番号を指定して下さい。";AA
if AA<1 or AA>7 then *41
on AA goto *131,*132,*133,*134,*135,*SYUSEI2,*3TEN
'
*131:cls:locate 20,6:input "何番目の座標か ";J1
locate 20,8:input "点名 ";K$(J1)
locate 20,10:input "座標 Ｘ＝ ";X(J1)
locate 20,12:input "座標 Ｙ＝ ";Y(J1):goto *SYUSEI2
*132:CLS:locate 20,12:input " 拡幅長 W1= 右＋ 左－ ";W1:goto *SYUSEI2
*133:cls:locate 20,12:input " 拡幅長 W2= 右＋ 左－ ";W2:goto *SYUSEI2
*134:CLS:locate 20,12:input " 方向角 T3= ";T(3):goto *SYUSEI2
*135:cls:locate 20,12:input " 交点名 = ";K1$:goto *SYUSEI2
'
*KEISAN2:'---------計 算 中---------
cls:locate 30,12:print "計 算 中"
DX=X(2)-X(1):DY=Y(2)-Y(1):gosub *STSUB:T1=tan(TD):S0=SS:TN=TD:gosub *7200:TA0=TN
H1=TD+PI/2#:X1=X(1)+cos(H1)*W1:Y1=Y(1)+sin(H1)*W1
TN=T(3):gosub *7010:T2=tan(TN):H2=TN+PI/2#:X2=X(3)+cos(H2)*W2:Y2=Y(3)+sin(H2)*W2
gosub *KOUTENSUB
'
'------------計算書作成------------
cls:locate 30,12:print "印 刷 中"
lprint:lprint:lprint:lprint:lprint:lprint:lprint:lprint tab(20) "三 点 座 標 と 一 方 向 に よ る 交 点 計 算 書":lprint:lprint:lprint:lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 右＋ 左－";K$(1),1,X(1),1,Y(1):lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 W1=###.###";K$(2),2,X(2),2,Y(2),W1:lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 W2=###.###";K$(3),3,X(3),3,Y(3),W2:lprint
lprint using " 方向角 T3 =#######.######";T(3):lprint
lprint AN1$:lprint
lprint using " 交点 & & X=#######.##### Y=#######.#####";K1$,XX,YY:lprint
lprint AN1$:lprint
lprint using " 全体距離１ S1=####.##### 方向角１ T1=####.###### S=#####.#####";S0,TA0,SS1:lprint
lprint using " 方向角２ T2=####.###### S=#####.#####";T(3),SS2:lprint
lprint chr$(12);
'
goto *3TEN
'
*2TEN:'-----------二点座標と二方向による交点計算------------
cls:locate 20,5:print "＊＊＊作業メニュ－ ＊＊＊"
gosub *MENU1
on JJA goto *DATRIN3,*SYUSEI3,*KEISAN3,*ENDD1
'
*DATRIN3:'-------デ－タ 入力-------
cls:locate 20,2:print "-----------デ－タの入力-----------"
locate 20,5:input "点名1 ";K$(1)
locate 20,6:input " 座標 X= ";X(1)
locate 20,7:input " 座標 Y= ";Y(1)
locate 20,8:input " 方向角 T1= ";T(1)
locate 20,9:input " 拡幅長 W1= 右＋ 左－ ";W(1)
locate 20,11:input "点名2 ";K$(2)
locate 20,12:input " 座標 X= ";X(2)
locate 20,13:input " 座標 Y= ";Y(2)
locate 20,14:input " 方向角 T2= ";T(2)
locate 20,15:input " 拡幅長 W2= 右＋ 左－ ";W(2)
locate 20,17:input " 交点名 = ";K1$:goto 2TEN
'
*SYUSEI3:'--------デ－タ－の修正-----------
cls:locate 20,1:print "--------デ－タ－の修正-----------"
locate 30,6:print "座標値の修正・・・１"
locate 20,8:print "拡幅長 Ｗ１＝・・２"
locate 20,10:print "拡幅長 Ｗ２＝・・３"
locate 20,12:print "方向角 Ｔ１＝・・４"
locate 20,12:print "方向角 Ｔ２＝・・５"
locate 20,14:print "交点名・・・・・・６"
locate 20,16:print "次の修正点・・・・７"
locate 20,18:print "終 了・・・・・・８"
'
*42:locate 35,22:input "番号を指定して下さい。";AA
if AA<1 or AA>8 then *42
on AA goto *199,*200,*201,*202,*203,*204,*SYUSEI3,*2TEN
'
*199:cls:locate 20,6:input "何番目の座標か ";J1
locate 20,8:input "点名 ";K$(J1)
locate 20,10:input "座標 Ｘ＝ ";X(J1)
locate 20,12:input "座標 Ｙ＝ ";Y(J1):goto *SYUSEI3
*200:cls:locate 20,12:input " 拡幅長 W1= 右＋ 左－ ";W(1):goto *SYUSEI3
*201:cls:locate 20,12:input " 拡幅長 W2= 右＋ 左－ ";W(2):goto *SYUSEI3
*202:cls:locate 20,12:input " 方向角 T1= ";T(1):goto *SYUSEI3
*203:cls:locate 20,12:input " 方向角 T2= ";T(2):goto *SYUSEI3
*204:cls:locate 20,12:input " 交点名 = ";K1$:goto *SYUSEI3
'
*KEISAN3:'---------計 算 中---------
cls:locate 30,12:print "計 算 中"
TN=T(1):gosub *7010:T1=tan(TN):H1=TN+PI/2#:X1=X(1)+cos(H1)*W(1):Y1=Y(1)+sin(H1)*W(1)
TN=T(2):gosub *7010:T2=tan(TN):H2=TN+PI/2#:X2=X(2)+cos(H2)*W(2):Y2=Y(2)+sin(H2)*W(2)
gosub *KOUTENSUB
'------------計算書作成------------
cls:locate 30,12:print "印 刷 中"
lprint:lprint:lprint:lprint:lprint:lprint:lprint:lprint tab(20)"二 点 座 標 と 二 方 向 に よ る 交 点 計 算 書":lprint:lprint:lprint:lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 W1=###.###";K$(1),1,X(1),1,Y(1),W(1):lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 W2=###.###";K$(2),2,X(2),2,Y(2),W(2):lprint
lprint using " 方向角 1=####.###### 方向角 2=####.###### 拡幅 右＋ 左－";T(1),T(2):lprint
lprint AN1$:lprint
lprint using " 交点 & & X=#######.##### Y=#######.#####";K1$,XX,YY:lprint
lprint AN1$:lprint
lprint using " 方向角１ T1=####.###### S=#####.#####";T(1),SS1:lprint
lprint using " 方向角２ T2=####.###### S=#####.#####";T(2),SS2:lprint
lprint chr$(12);
'
goto *2TEN
'
*EN1:'---------------直線と円の交点計算-------------
cls:locate 20,5:print "＊＊＊作業メニュ－ ＊＊＊"
gosub *MENU1
on JJA goto *DATRIN4,*SYUSEI4,*KEISAN4,*ENDD1
'
*DATRIN4:'-------デ－タ 入力-------
cls:locate 20,2:print "-----------デ－タの入力-----------"
locate 20,5:input " 点名1 ";K$(1)
locate 20,6:input " 座標 X1= ";X(1)
locate 20,7:input " 座標 Y1= ";Y(1)
locate 20,9:input " 点名2 ";K$(2)
locate 20,10:input " 座標 X2= ";X(2)
locate 20,11:input " 座標 Y2= ";Y(2)
locate 20,13:input " 円の中心座標 X3= ";X(3)
locate 20,14:input " 円の中心座標 Y3= ";Y(3)
locate 20,15:input " 半 径 R0= ";R0
locate 20,17:input " 交点名 = ";K1$:goto *EN1
'
*SYUSEI4:'--------デ－タ－の修正-----------
cls:locate 20,1:print "--------デ－タ－の修正-----------"
locate 20,3:print " 点名1 ・・・１"
locate 20,4:print " 座標 X1=・・・２"
locate 20,5:print " 座標 Y1=・・・３"
locate 20,7:print " 点名2 ・・・・４"
locate 20,8:print " 座標 X2=・・・５"
locate 20,9:print " 座標 Y2=・・・６"
locate 20,11:print " 円の中心座標 X3=・・・７"
locate 20,12:print " 円の中心座標 Y3=・・・８"
locate 20,13:print " 半 径 R0=・・・９"
locate 20,15:print " 交点名 ・・・・・１０"
locate 20,17:print " 次の修正点 ・・・１１"
locate 20,19:print " 終 了 ・・・・・１２"
'
*259:locate 30,21:input "番号を指定して下さい。";AA
if AA<1 or AA>12 then *259
on AA goto *263,*264,*265,*266,*267,*268,*269,*270,*271,*272,*SYUSEI4,*EN1
'
*263:cls:locate 20,10:input " 点名1 ";K$(1):goto *SYUSEI4
*264:cls:locate 20,10:input " 座標 X1= ";X(1):goto *SYUSEI4
*265:cls:locate 20,10:input " 座標 Y1= ";Y(1):goto *SYUSEI4
*266:cls:locate 20,10:input " 点名2 ";K$(2):goto *SYUSEI4
*267:cls:locate 20,10:input " 座標 X2= ";X(2):goto *SYUSEI4
*268:cls:locate 20,10:input " 座標 Y2= ";Y(2):goto *SYUSEI4
*269:cls:locate 20,10:input " 円の中心座標 X3= ";X(3):goto *SYUSEI4
*270:cls:locate 20,10:input " 円の中心座標 Y3= ";Y(3):goto *SYUSEI4
*271:cls:locate 20,10:input " 半 径 R0= ";R0:goto *SYUSEI4
*272:cls:locate 20,10:input " 交点名 = ";K1$:goto *SYUSEI4
'
*KEISAN4:'---------計 算 中---------
cls:locate 30,12:print "計 算 中"
DX=X(2)-X(1):DY=Y(2)-Y(1):gosub *STSUB:T1=tan(TD):S0=SS:TN=TD:gosub *7200:TA0=TN
DX=X(1)-X(3):DY=Y(1)-Y(3):T2=DX*T1-DY:gosub *ENCYOKUSUB
DX=XP1-X(1):DY=YP1-Y(1):GOSUB *STSUB:SS1=SS:DX=XP2-X(1):DY=YP2-Y(1):GOSUB *STSUB:SS2=SS
'
'------------計算書作成------------
cls:locate 30,12:print "印 刷 中"
lprint:lprint:lprint:lprint:lprint:lprint:lprint:lprint tab(20)"二 点 座 標 と 円 に よ る 交 点 計 算 書":lprint:lprint:lprint:lprint
lprint using " 直線 座標１ & &X1=#######.#### Y1=#######.####";K$(1),X(1),Y(1):lprint
lprint using " 直線 座標２ & &X2=#######.#### Y2=#######.####";K$(2),X(2),Y(2):lprint
lprint using " 円の中心座標 X3=#######.#### Y3=#######.#### ";X(3),Y(3):lprint
lprint using " 半 径 R=#######.####";R0:lprint
lprint AN1$:lprint
lprint using " 交点 1 & & X=#######.##### Y=#######.#####";K1$,XP1,YP1:lprint
lprint using " 交点 2 & & X=#######.##### Y=#######.#####";K1$,XP2,YP2:lprint
lprint AN1$:lprint
lprint using " 方向角１ T1=####.###### S=#####.#####";TA0,S0:lprint
lprint using " & &---->& & S=#####.#####";K$(1),K1$,SS1:lprint
lprint chr$(12);
'
goto *EN1
'
*EN2:'---------------円と円の交点計算-------------
cls:locate 20,5:print "＊＊＊作業メニュ－ ＊＊＊"
gosub *MENU1
on JJA goto *DATRIN5,*SYUSEI5,*KEISAN5,*ENDD1
'
*DATRIN5:'-------デ－タ 入力-------
cls:locate 20,2:print "-----------デ－タの入力-----------"
locate 20,5:input "円１の点名 ";K$(1)
locate 20,6:input " 座標 X1= ";X(1)
locate 20,7:input " Y1= ";Y(1)
locate 20,8:input " 半径 R1= ";R1
locate 20,10:input "円２の点名 ";K$(2)
locate 20,11:input " 座標 X2= ";X(2)
locate 20,12:input " Y2= ";Y(2)
locate 20,13:input " 半径 R2= ";R2
locate 20,15:input " 交点名 = ";K1$:goto *EN2
'
*SYUSEI5:'--------デ－タ－の修正-----------
cls:locate 20,1:print "--------デ－タ－の修正-----------"
locate 20,3:print "円１の点名 ・・・１"
locate 20,4:print " 座標 X1=・・・２"
locate 20,5:print " 座標 Y1=・・・３"
locate 20,6:print " 半径 R1=・・・４"
locate 20,7:print "円２の点名 ・・・・５"
locate 20,8:print " 座標 X2=・・・６"
locate 20,9:print " 座標 Y2=・・・７"
locate 20,10:print " 半径 R2=・・・８"
locate 20,12:print " 交点名 ・・・・・・９"
locate 20,14:print " 次の修正点 ・・・１０"
locate 20,16:print " 終 了 ・・・・・１１"
'
*339:locate 30,21:input "番号を指定して下さい。";AA
if AA<1 or AA>11 then *339
on AA goto *343,*344,*345,*346,*347,*348,*349,*350,*351,*SYUSEI5,*EN2
'
*343:cls:locate 20,10:input "円１の点名 ";K$(1):goto *SYUSEI5
*344:cls:locate 20,10:input " 座標 X1= ";X(1):goto *SYUSEI5
*345:cls:locate 20,10:input " 座標 Y1= ";Y(1):goto *SYUSEI5
*346:cls:locate 20,10:input " 半径 R1= ";R1:goto *SYUSEI5
*347:cls:locate 20,10:input "円２の点名 ";K$(2):goto *SYUSEI5
*348:cls:locate 20,10:input " 座標 X2= ";X(2):goto *SYUSEI5
*349:cls:locate 20,10:input " 座標 Y2= ";Y(2):goto *SYUSEI5
*350:cls:locate 20,10:input " 半径 R2= ";R2:goto *SYUSEI5
*351:cls:locate 20,10:input " 交点名 = ";K1$:goto *SYUSEI5
'
*KEISAN5:'---------計 算 中---------
cls:locate 30,12:print "計 算 中"
DX=X(2)-X(1):DY=Y(2)-Y(1):gosub *STSUB:S0=SS:TN=TD:gosub *7200:TA0=TN
gosub *ENENSUB
DX=XP2-XP1:DY=YP2-YP1:gosub *STSUB:SS1=SS:TN=TD:gosub *7200:TA1=TN
DX=XP1-X(1):DY=YP1-Y(1):gosub *STSUB:SS2=SS:TN=TD:gosub *7200:TA2=TN
'
'------------計算書作成------------
cls:locate 30,12:print "印 刷 中"
lprint:lprint:lprint:lprint:lprint:lprint:lprint:lprint tab(20)"円 と 円 に よ る 交 点 計 算 書":lprint:lprint:lprint:lprint
lprint using " 円１ & &X1=#######.#### Y1=#######.####";K$(1),X(1),Y(1):lprint
lprint using " 半 径 R=#######.####";R1:lprint
lprint using " 円２ & &X1=#######.#### Y1=#######.####";K$(2),X(2),Y(2):lprint
lprint using " 半 径 R=#######.####";R2:lprint
lprint AN1$:lprint
lprint using " 交点 1 & & X=#######.##### Y=#######.#####";K1$,XP1,YP1:lprint
lprint using " 交点 2 & & X=#######.##### Y=#######.#####";K1$,XP2,YP2:lprint
lprint AN1$:lprint
lprint using " 方向角 T1=####.###### S=#####.#####";TA0,S0:lprint
lprint using " 交点間 T2=####.###### S=#####.#####";TA1,SS1:lprint
lprint using " & &----->& & T2=####.###### S=#####.#####";K$(1),K1$,TA2,SS2:lprint
lprint chr$(12);
'
goto *EN2
'
'
*5200:'------角度の正規化-----
if TN=>360# then TN=TN-360#
*5210:if TN<0 then TN=TN+360#
if TN=>360 then *5200
if TN<0 then *5210
return
'
'
'
*MENU1
cls:locate 15,3:print"＊＊＊ 作 業 メニュウ－ ＊＊＊"
locate 20,6:print"デ－タの入力 ・・・・・・・1"
locate 20,8:print"デ－タの修正 ・・・・・・・2 "
locate 20,10:print"計算書の印刷 ・・・・・・・3 "
locate 20,12:print"作業の終了 ・・・・・・・・4 "
locate 30,16:input"番号を指定 ";JJA
if JJA<1 or JJA>4 then *MENU1
return
'
'
*7010:'---------度分秒からラジアンへの変換-------
D1=abs(TN):D2=(D1-fix(D1))*100#:D3=(D2-fix(D2))*100#
TN=sgn(TN)*(fix(D1)+fix(D2)/60#+D3/3600#)/RAA
return
'
*7100:'---------度分秒から度への変換-------
D1=abs(TN):D2=(D1-fix(D1))*100#:D3=(D2-fix(D2))*100#
TN=sgn(TN)*(fix(D1)+fix(D2)/60#+D3/3600#)
return
'
*7200:'------ラジアンから度分秒への変換-------
TN=TN*RAA
*286:if TN<0 then TN=TN+360#
if TN=>360# then TN=TN-360#
if TN=>360# or TN<0 then *286
TDD=fix(TN):TM=(TN-TDD)*60#:TMM=fix(TM):TS=(TM-TMM)*60#
TN=TDD+TMM/100#+TS/10000#
return
'
*7600:'-----------デ－タの入力-----------
cls:locate 20,2:print "-----------デ－タの入力-----------"
locate 20,5:input "ＢＣの点名 ";KK$
locate 20,7:input " 座標 X= ";XB
locate 20,9:input " 座標 Y= ";YB
locate 20,11:input "接線方向角 T0= ";T0
locate 20,13:input " 半 径 R= ";R0
locate 20,15:input " 交 角 IA= ";TIA
locate 20,17:input " 幅 員 B= ";BB
return
'
*7700:'--------円曲線の要素 SUB------------
cls:locate 20,10:print "-----------円曲線の要素 SUB-----------"
TR2=TBIA/2#
R=abs(R):TL=R*tan(TR2):DCL=R*TBIA:SL=R*(1#/cos(TR2)-1#)
DM=R*(1#-cos(TR2)):DC=2#*R*sin(TR2)
return
'
*STSUB:'---------ST SUB---------
SS=sqr(DX*DX+DY*DY):TD=atn(DY/(DX+EE)):TT=TD*RAA
if DX<0 then TT=TT+180#
if DY<0 then TT=TT+360#
TD=TT*RRA
return
'
*KOUTENSUB:'--------交点 SUB---------
XX=(T2*X2-T1*X1+Y1-Y2)/(T2-T1):YY=T1*(XX-X1)+Y1
DX=X1-XX:DY=Y1-YY:gosub *STSUB:TT1=TT:TD1=TD:SS1=SS
DX=X2-XX:DY=Y2-YY:gosub *STSUB:TT2=TT:TD2=TD:SS2=SS
return
'
*ENCYOKUSUB:'------------直線と円の交点 SUB----------
T3=T1*T1+1#:T4=sqr(R0*R0*T3-T2*T2)
XP1=(T1*T2+T4)/T3+X(3):YP1=*6:DAT=atn(DATT)
DCOS=PI/2#-DAT:DRA=DCOS
TN=TA0:gosub *7010:TN0=TN:TR1=TN0+DCOS:TR2=TN0-DCOS
XP1=X(1)+cos(TR1)*R1:YP1=Y(1)+sin(TR1)*R1
XP2=X(1)+cos(TR2)*R1:YP2=Y(1)+sin(TR2)*R1
return
'
*ENDD1
'
end
'-----------交点計算-------------
defdbl D-H,L,P-Y:defstr N,K:defint a,I,J,c
PI=3.141592653589793#:EE=0.0000000001#
RA=206264.806471#:RAA=180#/PI:RRA=PI/180#
dim NN$(50),N2$(50),XR(50),YR(50),XL(50),YL(50),SS(20),S(20)
def fnRAA(D)=(fix(D)+fix*1/36)/RAA:'-----度分秒からラジアンへ------
def fnDEG(T)=fix(T)+fix(((T)-fix(T))*100#)/60#+*2/0.36#:'-----度分秒から度へ------
def fnDMS(T)=fix(T)+fix*3*60#)/100#+*4*60#-fix*5*60#))*0.006#:'-----度から度分秒へ------
AN1$=" －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－"
'-----------------
*SENTAKU1
cls:locate 20,3:print"計算の項目を選択して下さい。"
locate 25,6:print"四点座標による計算・・・・・・・・・１"
locate 25,8:print"三点座標と一方向による計算・・・・・２"
locate 25,10:print"二点座標と二方向による計算・・・・・３"
locate 25,12:print"直線と円による計算・・・・・・・・・４"
locate 25,14:print"円と円による計算・・・・・・・・・・５"
locate 25,16:print"作業終了・・・・・・・・・・・・・・６"
locate 30,20:input"番号を選択して下さい。 ";JO
if JO<1 or JO>6 then *SENTAKU1
on JO goto *4TEN,*3TEN,*2TEN,*EN1,*EN2,*ENDD1
'
goto *SENTAKU1
'
*4TEN:'-----四点座標による計算-----
'-----作業メニュ－-----
gosub *MENU1
on JJA goto *DATRIN1,*SYUSEI1,*KEISAN1,*ENDD1
'
*DATRIN1:'-------デ－タ 入力-------
cls:locate 20,1:print "-----------デ－タの入力-----------"
locate 20,4:input "点名1 ";K$(1)
locate 20,5:input " 座標 X= ";X(1)
locate 20,6:input " 座標 Y= ";Y(1)
locate 20,8:input "点名2 ";K$(2)
locate 20,9:input " 座標 X= ";X(2)
locate 20,10:input " 座標 Y= ";Y(2)
locate 20,11:input " 拡幅長 W1= 右＋ 左－";W1
locate 20,13:input "点名3 ";K$(3)
locate 20,14:input " 座標 X= ";X(3)
locate 20,15:input " 座標 Y= ";Y(3)
locate 20,17:input "点名4 ";K$(4)
locate 20,18:input " 座標 X= ";X(4)
locate 20,19:input " 座標 Y= ";Y(4)
locate 20,20:input " 拡幅長 W2= 右＋ 左－ ";W2
locate 20,22:input " 交点名 = ";K1$
'
goto *4TEN
'
*SYUSEI1:'--------デ－タ－の修正-----------
cls:locate 20,3:print "--------デ－タ－の修正-----------"
locate 20,6:print "座標値の修正・・・１"
locate 20,8:print "拡幅長 Ｗ１＝・・２"
locate 20,10:print "拡幅長 Ｗ２＝・・３"
locate 20,12:print "交点名・・・・・・４"
locate 20,14:print "次の修正点・・・・５"
locate 20,16:print "終 了・・・・・・６"
'
*40:locate 35,19:input "番号を指定して下さい。";AA
if AA<1 or AA>6 then *40
on AA goto *63,*64,*65,*66,*SYUSEI1,*4TEN
'
*63:cls:locate 20,6:input "何番目の座標か ";J1
locate 20,8:input "点名 ";K$(J1)
locate 20,10:input "座標 Ｘ＝ ";X(J1)
locate 20,12:input "座標 Ｙ＝ ";Y(J1):goto *SYUSEI1
*64:CLS:locate 20,12:input " 拡幅長 W1= 右＋ 左－ ";W1:goto *SYUSEI1
*65:CLS:locate 20,12:input " 拡幅長 W2= 右＋ 左－ ";W2:goto *SYUSEI1
*66:CLS:locate 20,12:input " 交点名 = ";K1$:goto *SYUSEI1
'
*KEISAN1:'------計 算 中---------
cls:locate 30,12:print "計 算 中"
DX=X(2)-X(1):DY=Y(2)-Y(1):gosub *STSUB:T1=tan(TD):S0=SS:TN=TD:gosub *7200:TA0=TN
H1=TD+PI/2#:X1=X(1)+cos(H1)*W1:Y1=Y(1)+sin(H1)*W1
DX=X(4)-X(3):DY=Y(4)-Y(3):gosub *STSUB:T2=tan(TD):SS0=SS:TN=TD:gosub *7200:TB0=TN
H2=TD+PI/2#:X2=X(3)+cos(H2)*W2:Y2=Y(3)+sin(H2)*W2
gosub *KOUTENSUB
'
'------------計算書作成------------
CLS:locate 30,12:print "印 刷 中"
lprint:lprint:lprint:lprint:lprint:lprint:lprint:lprint tab(30)"四 点 座 標 に よ る 交 点 計 算 書":lprint:lprint:lprint:lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 右＋ 左－ ";K$(1),1,X(1),1,Y(1):lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 W1=###.###";K$(2),2,X(2),2,Y(2),W1:lprint
lprint using " & & X##=#######.#### Y##=#######.####";K$(3),3,X(3),3,Y(3):lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 W2=###.###";K$(4),4,X(4),4,Y(4),W2:lprint
lprint AN1$:lprint
lprint using " 交点 & & X=#######.##### Y=#######.#####";K1$,XX,YY:lprint
lprint AN1$:lprint
lprint using " 全体距離１ S1=####.##### 方向角１ T1=####.###### S=#####.#####";S0,TA0,SS1:lprint
lprint using " 全体距離２ S2=####.##### 方向角２ T2=####.###### S=#####.#####";SS0,TB0,SS2:lprint
lprint chr$(12);
'
goto *4TEN
'
*3TEN:'-----------三点座標と一方向による交点計算------------
locate 20,5:print "＊＊＊作業メニュ－ ＊＊＊"
gosub *MENU1
on JJA goto *DATRIN2,*SYUSEI2,*KEISAN2,*ENDD1
'
*DATRIN2:'-------デ－タ 入力-------
cls:locate 20,2:print "-----------デ－タの入力-----------"
locate 20,5:input "点名1 ";K$(1)
locate 20,6:input " 座標 X= ";X(1)
locate 20,7:input " 座標 Y= ";Y(1)
locate 20,9:input "点名2 ";K$(2)
locate 20,10:input " 座標 X= ";X(2)
locate 20,11:input " 座標 Y= ";Y(2)
locate 20,12:input " 拡幅長 W1= 右＋ 左－ ";W1
locate 20,14:input "点名3 ";K$(3)
locate 20,15:input " 座標 X= ";X(3)
locate 20,16:input " 座標 Y= ";Y(3)
locate 20,17:input " 方向角 T3= ";T(3)
locate 20,18:input " 拡幅長 W2= 右＋ 左－ ";W2
locate 20,21:input " 交点名 = ";K1$
'
goto *3TEN
'
*SYUSEI2:'--------デ－タ－の修正-----------
cls:locate 20,1:print "--------デ－タ－の修正-----------"
locate 30,6:print "座標値の修正・・・１"
locate 20,8:print "拡幅長 Ｗ１＝・・２"
locate 20,10:print "拡幅長 Ｗ２＝・・３"
locate 20,12:print "方向角 Ｔ０＝・・４"
locate 20,14:print "交点名・・・・・・５"
locate 20,16:print "次の修正点・・・・６"
locate 20,18:print "終 了・・・・・・７"
'
*41:locate 35,21:input "番号を指定して下さい。";AA
if AA<1 or AA>7 then *41
on AA goto *131,*132,*133,*134,*135,*SYUSEI2,*3TEN
'
*131:cls:locate 20,6:input "何番目の座標か ";J1
locate 20,8:input "点名 ";K$(J1)
locate 20,10:input "座標 Ｘ＝ ";X(J1)
locate 20,12:input "座標 Ｙ＝ ";Y(J1):goto *SYUSEI2
*132:CLS:locate 20,12:input " 拡幅長 W1= 右＋ 左－ ";W1:goto *SYUSEI2
*133:cls:locate 20,12:input " 拡幅長 W2= 右＋ 左－ ";W2:goto *SYUSEI2
*134:CLS:locate 20,12:input " 方向角 T3= ";T(3):goto *SYUSEI2
*135:cls:locate 20,12:input " 交点名 = ";K1$:goto *SYUSEI2
'
*KEISAN2:'---------計 算 中---------
cls:locate 30,12:print "計 算 中"
DX=X(2)-X(1):DY=Y(2)-Y(1):gosub *STSUB:T1=tan(TD):S0=SS:TN=TD:gosub *7200:TA0=TN
H1=TD+PI/2#:X1=X(1)+cos(H1)*W1:Y1=Y(1)+sin(H1)*W1
TN=T(3):gosub *7010:T2=tan(TN):H2=TN+PI/2#:X2=X(3)+cos(H2)*W2:Y2=Y(3)+sin(H2)*W2
gosub *KOUTENSUB
'
'------------計算書作成------------
cls:locate 30,12:print "印 刷 中"
lprint:lprint:lprint:lprint:lprint:lprint:lprint:lprint tab(20) "三 点 座 標 と 一 方 向 に よ る 交 点 計 算 書":lprint:lprint:lprint:lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 右＋ 左－";K$(1),1,X(1),1,Y(1):lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 W1=###.###";K$(2),2,X(2),2,Y(2),W1:lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 W2=###.###";K$(3),3,X(3),3,Y(3),W2:lprint
lprint using " 方向角 T3 =#######.######";T(3):lprint
lprint AN1$:lprint
lprint using " 交点 & & X=#######.##### Y=#######.#####";K1$,XX,YY:lprint
lprint AN1$:lprint
lprint using " 全体距離１ S1=####.##### 方向角１ T1=####.###### S=#####.#####";S0,TA0,SS1:lprint
lprint using " 方向角２ T2=####.###### S=#####.#####";T(3),SS2:lprint
lprint chr$(12);
'
goto *3TEN
'
*2TEN:'-----------二点座標と二方向による交点計算------------
cls:locate 20,5:print "＊＊＊作業メニュ－ ＊＊＊"
gosub *MENU1
on JJA goto *DATRIN3,*SYUSEI3,*KEISAN3,*ENDD1
'
*DATRIN3:'-------デ－タ 入力-------
cls:locate 20,2:print "-----------デ－タの入力-----------"
locate 20,5:input "点名1 ";K$(1)
locate 20,6:input " 座標 X= ";X(1)
locate 20,7:input " 座標 Y= ";Y(1)
locate 20,8:input " 方向角 T1= ";T(1)
locate 20,9:input " 拡幅長 W1= 右＋ 左－ ";W(1)
locate 20,11:input "点名2 ";K$(2)
locate 20,12:input " 座標 X= ";X(2)
locate 20,13:input " 座標 Y= ";Y(2)
locate 20,14:input " 方向角 T2= ";T(2)
locate 20,15:input " 拡幅長 W2= 右＋ 左－ ";W(2)
locate 20,17:input " 交点名 = ";K1$:goto 2TEN
'
*SYUSEI3:'--------デ－タ－の修正-----------
cls:locate 20,1:print "--------デ－タ－の修正-----------"
locate 30,6:print "座標値の修正・・・１"
locate 20,8:print "拡幅長 Ｗ１＝・・２"
locate 20,10:print "拡幅長 Ｗ２＝・・３"
locate 20,12:print "方向角 Ｔ１＝・・４"
locate 20,12:print "方向角 Ｔ２＝・・５"
locate 20,14:print "交点名・・・・・・６"
locate 20,16:print "次の修正点・・・・７"
locate 20,18:print "終 了・・・・・・８"
'
*42:locate 35,22:input "番号を指定して下さい。";AA
if AA<1 or AA>8 then *42
on AA goto *199,*200,*201,*202,*203,*204,*SYUSEI3,*2TEN
'
*199:cls:locate 20,6:input "何番目の座標か ";J1
locate 20,8:input "点名 ";K$(J1)
locate 20,10:input "座標 Ｘ＝ ";X(J1)
locate 20,12:input "座標 Ｙ＝ ";Y(J1):goto *SYUSEI3
*200:cls:locate 20,12:input " 拡幅長 W1= 右＋ 左－ ";W(1):goto *SYUSEI3
*201:cls:locate 20,12:input " 拡幅長 W2= 右＋ 左－ ";W(2):goto *SYUSEI3
*202:cls:locate 20,12:input " 方向角 T1= ";T(1):goto *SYUSEI3
*203:cls:locate 20,12:input " 方向角 T2= ";T(2):goto *SYUSEI3
*204:cls:locate 20,12:input " 交点名 = ";K1$:goto *SYUSEI3
'
*KEISAN3:'---------計 算 中---------
cls:locate 30,12:print "計 算 中"
TN=T(1):gosub *7010:T1=tan(TN):H1=TN+PI/2#:X1=X(1)+cos(H1)*W(1):Y1=Y(1)+sin(H1)*W(1)
TN=T(2):gosub *7010:T2=tan(TN):H2=TN+PI/2#:X2=X(2)+cos(H2)*W(2):Y2=Y(2)+sin(H2)*W(2)
gosub *KOUTENSUB
'------------計算書作成------------
cls:locate 30,12:print "印 刷 中"
lprint:lprint:lprint:lprint:lprint:lprint:lprint:lprint tab(20)"二 点 座 標 と 二 方 向 に よ る 交 点 計 算 書":lprint:lprint:lprint:lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 W1=###.###";K$(1),1,X(1),1,Y(1),W(1):lprint
lprint using " & & X##=#######.#### Y##=#######.#### 拡幅 W2=###.###";K$(2),2,X(2),2,Y(2),W(2):lprint
lprint using " 方向角 1=####.###### 方向角 2=####.###### 拡幅 右＋ 左－";T(1),T(2):lprint
lprint AN1$:lprint
lprint using " 交点 & & X=#######.##### Y=#######.#####";K1$,XX,YY:lprint
lprint AN1$:lprint
lprint using " 方向角１ T1=####.###### S=#####.#####";T(1),SS1:lprint
lprint using " 方向角２ T2=####.###### S=#####.#####";T(2),SS2:lprint
lprint chr$(12);
'
goto *2TEN
'
*EN1:'---------------直線と円の交点計算-------------
cls:locate 20,5:print "＊＊＊作業メニュ－ ＊＊＊"
gosub *MENU1
on JJA goto *DATRIN4,*SYUSEI4,*KEISAN4,*ENDD1
'
*DATRIN4:'-------デ－タ 入力-------
cls:locate 20,2:print "-----------デ－タの入力-----------"
locate 20,5:input " 点名1 ";K$(1)
locate 20,6:input " 座標 X1= ";X(1)
locate 20,7:input " 座標 Y1= ";Y(1)
locate 20,9:input " 点名2 ";K$(2)
locate 20,10:input " 座標 X2= ";X(2)
locate 20,11:input " 座標 Y2= ";Y(2)
locate 20,13:input " 円の中心座標 X3= ";X(3)
locate 20,14:input " 円の中心座標 Y3= ";Y(3)
locate 20,15:input " 半 径 R0= ";R0
locate 20,17:input " 交点名 = ";K1$:goto *EN1
'
*SYUSEI4:'--------デ－タ－の修正-----------
cls:locate 20,1:print "--------デ－タ－の修正-----------"
locate 20,3:print " 点名1 ・・・１"
locate 20,4:print " 座標 X1=・・・２"
locate 20,5:print " 座標 Y1=・・・３"
locate 20,7:print " 点名2 ・・・・４"
locate 20,8:print " 座標 X2=・・・５"
locate 20,9:print " 座標 Y2=・・・６"
locate 20,11:print " 円の中心座標 X3=・・・７"
locate 20,12:print " 円の中心座標 Y3=・・・８"
locate 20,13:print " 半 径 R0=・・・９"
locate 20,15:print " 交点名 ・・・・・１０"
locate 20,17:print " 次の修正点 ・・・１１"
locate 20,19:print " 終 了 ・・・・・１２"
'
*259:locate 30,21:input "番号を指定して下さい。";AA
if AA<1 or AA>12 then *259
on AA goto *263,*264,*265,*266,*267,*268,*269,*270,*271,*272,*SYUSEI4,*EN1
'
*263:cls:locate 20,10:input " 点名1 ";K$(1):goto *SYUSEI4
*264:cls:locate 20,10:input " 座標 X1= ";X(1):goto *SYUSEI4
*265:cls:locate 20,10:input " 座標 Y1= ";Y(1):goto *SYUSEI4
*266:cls:locate 20,10:input " 点名2 ";K$(2):goto *SYUSEI4
*267:cls:locate 20,10:input " 座標 X2= ";X(2):goto *SYUSEI4
*268:cls:locate 20,10:input " 座標 Y2= ";Y(2):goto *SYUSEI4
*269:cls:locate 20,10:input " 円の中心座標 X3= ";X(3):goto *SYUSEI4
*270:cls:locate 20,10:input " 円の中心座標 Y3= ";Y(3):goto *SYUSEI4
*271:cls:locate 20,10:input " 半 径 R0= ";R0:goto *SYUSEI4
*272:cls:locate 20,10:input " 交点名 = ";K1$:goto *SYUSEI4
'
*KEISAN4:'---------計 算 中---------
cls:locate 30,12:print "計 算 中"
DX=X(2)-X(1):DY=Y(2)-Y(1):gosub *STSUB:T1=tan(TD):S0=SS:TN=TD:gosub *7200:TA0=TN
DX=X(1)-X(3):DY=Y(1)-Y(3):T2=DX*T1-DY:gosub *ENCYOKUSUB
DX=XP1-X(1):DY=YP1-Y(1):GOSUB *STSUB:SS1=SS:DX=XP2-X(1):DY=YP2-Y(1):GOSUB *STSUB:SS2=SS
'
'------------計算書作成------------
cls:locate 30,12:print "印 刷 中"
lprint:lprint:lprint:lprint:lprint:lprint:lprint:lprint tab(20)"二 点 座 標 と 円 に よ る 交 点 計 算 書":lprint:lprint:lprint:lprint
lprint using " 直線 座標１ & &X1=#######.#### Y1=#######.####";K$(1),X(1),Y(1):lprint
lprint using " 直線 座標２ & &X2=#######.#### Y2=#######.####";K$(2),X(2),Y(2):lprint
lprint using " 円の中心座標 X3=#######.#### Y3=#######.#### ";X(3),Y(3):lprint
lprint using " 半 径 R=#######.####";R0:lprint
lprint AN1$:lprint
lprint using " 交点 1 & & X=#######.##### Y=#######.#####";K1$,XP1,YP1:lprint
lprint using " 交点 2 & & X=#######.##### Y=#######.#####";K1$,XP2,YP2:lprint
lprint AN1$:lprint
lprint using " 方向角１ T1=####.###### S=#####.#####";TA0,S0:lprint
lprint using " & &---->& & S=#####.#####";K$(1),K1$,SS1:lprint
lprint chr$(12);
'
goto *EN1
'
*EN2:'---------------円と円の交点計算-------------
cls:locate 20,5:print "＊＊＊作業メニュ－ ＊＊＊"
gosub *MENU1
on JJA goto *DATRIN5,*SYUSEI5,*KEISAN5,*ENDD1
'
*DATRIN5:'-------デ－タ 入力-------
cls:locate 20,2:print "-----------デ－タの入力-----------"
locate 20,5:input "円１の点名 ";K$(1)
locate 20,6:input " 座標 X1= ";X(1)
locate 20,7:input " Y1= ";Y(1)
locate 20,8:input " 半径 R1= ";R1
locate 20,10:input "円２の点名 ";K$(2)
locate 20,11:input " 座標 X2= ";X(2)
locate 20,12:input " Y2= ";Y(2)
locate 20,13:input " 半径 R2= ";R2
locate 20,15:input " 交点名 = ";K1$:goto *EN2
'
*SYUSEI5:'--------デ－タ－の修正-----------
cls:locate 20,1:print "--------デ－タ－の修正-----------"
locate 20,3:print "円１の点名 ・・・１"
locate 20,4:print " 座標 X1=・・・２"
locate 20,5:print " 座標 Y1=・・・３"
locate 20,6:print " 半径 R1=・・・４"
locate 20,7:print "円２の点名 ・・・・５"
locate 20,8:print " 座標 X2=・・・６"
locate 20,9:print " 座標 Y2=・・・７"
locate 20,10:print " 半径 R2=・・・８"
locate 20,12:print " 交点名 ・・・・・・９"
locate 20,14:print " 次の修正点 ・・・１０"
locate 20,16:print " 終 了 ・・・・・１１"
'
*339:locate 30,21:input "番号を指定して下さい。";AA
if AA<1 or AA>11 then *339
on AA goto *343,*344,*345,*346,*347,*348,*349,*350,*351,*SYUSEI5,*EN2
'
*343:cls:locate 20,10:input "円１の点名 ";K$(1):goto *SYUSEI5
*344:cls:locate 20,10:input " 座標 X1= ";X(1):goto *SYUSEI5
*345:cls:locate 20,10:input " 座標 Y1= ";Y(1):goto *SYUSEI5
*346:cls:locate 20,10:input " 半径 R1= ";R1:goto *SYUSEI5
*347:cls:locate 20,10:input "円２の点名 ";K$(2):goto *SYUSEI5
*348:cls:locate 20,10:input " 座標 X2= ";X(2):goto *SYUSEI5
*349:cls:locate 20,10:input " 座標 Y2= ";Y(2):goto *SYUSEI5
*350:cls:locate 20,10:input " 半径 R2= ";R2:goto *SYUSEI5
*351:cls:locate 20,10:input " 交点名 = ";K1$:goto *SYUSEI5
'
*KEISAN5:'---------計 算 中---------
cls:locate 30,12:print "計 算 中"
DX=X(2)-X(1):DY=Y(2)-Y(1):gosub *STSUB:S0=SS:TN=TD:gosub *7200:TA0=TN
gosub *ENENSUB
DX=XP2-XP1:DY=YP2-YP1:gosub *STSUB:SS1=SS:TN=TD:gosub *7200:TA1=TN
DX=XP1-X(1):DY=YP1-Y(1):gosub *STSUB:SS2=SS:TN=TD:gosub *7200:TA2=TN
'
'------------計算書作成------------
cls:locate 30,12:print "印 刷 中"
lprint:lprint:lprint:lprint:lprint:lprint:lprint:lprint tab(20)"円 と 円 に よ る 交 点 計 算 書":lprint:lprint:lprint:lprint
lprint using " 円１ & &X1=#######.#### Y1=#######.####";K$(1),X(1),Y(1):lprint
lprint using " 半 径 R=#######.####";R1:lprint
lprint using " 円２ & &X1=#######.#### Y1=#######.####";K$(2),X(2),Y(2):lprint
lprint using " 半 径 R=#######.####";R2:lprint
lprint AN1$:lprint
lprint using " 交点 1 & & X=#######.##### Y=#######.#####";K1$,XP1,YP1:lprint
lprint using " 交点 2 & & X=#######.##### Y=#######.#####";K1$,XP2,YP2:lprint
lprint AN1$:lprint
lprint using " 方向角 T1=####.###### S=#####.#####";TA0,S0:lprint
lprint using " 交点間 T2=####.###### S=#####.#####";TA1,SS1:lprint
lprint using " & &----->& & T2=####.###### S=#####.#####";K$(1),K1$,TA2,SS2:lprint
lprint chr$(12);
'
goto *EN2
'
'
*5200:'------角度の正規化-----
if TN=>360# then TN=TN-360#
*5210:if TN<0 then TN=TN+360#
if TN=>360 then *5200
if TN<0 then *5210
return
'
'
'
*MENU1
cls:locate 15,3:print"＊＊＊ 作 業 メニュウ－ ＊＊＊"
locate 20,6:print"デ－タの入力 ・・・・・・・1"
locate 20,8:print"デ－タの修正 ・・・・・・・2 "
locate 20,10:print"計算書の印刷 ・・・・・・・3 "
locate 20,12:print"作業の終了 ・・・・・・・・4 "
locate 30,16:input"番号を指定 ";JJA
if JJA<1 or JJA>4 then *MENU1
return
'
'
*7010:'---------度分秒からラジアンへの変換-------
D1=abs(TN):D2=(D1-fix(D1))*100#:D3=(D2-fix(D2))*100#
TN=sgn(TN)*(fix(D1)+fix(D2)/60#+D3/3600#)/RAA
return
'
*7100:'---------度分秒から度への変換-------
D1=abs(TN):D2=(D1-fix(D1))*100#:D3=(D2-fix(D2))*100#
TN=sgn(TN)*(fix(D1)+fix(D2)/60#+D3/3600#)
return
'
*7200:'------ラジアンから度分秒への変換-------
TN=TN*RAA
*286:if TN<0 then TN=TN+360#
if TN=>360# then TN=TN-360#
if TN=>360# or TN<0 then *286
TDD=fix(TN):TM=(TN-TDD)*60#:TMM=fix(TM):TS=(TM-TMM)*60#
TN=TDD+TMM/100#+TS/10000#
return
'
*7600:'-----------デ－タの入力-----------
cls:locate 20,2:print "-----------デ－タの入力-----------"
locate 20,5:input "ＢＣの点名 ";KK$
locate 20,7:input " 座標 X= ";XB
locate 20,9:input " 座標 Y= ";YB
locate 20,11:input "接線方向角 T0= ";T0
locate 20,13:input " 半 径 R= ";R0
locate 20,15:input " 交 角 IA= ";TIA
locate 20,17:input " 幅 員 B= ";BB
return
'
*7700:'--------円曲線の要素 SUB------------
cls:locate 20,10:print "-----------円曲線の要素 SUB-----------"
TR2=TBIA/2#
R=abs(R):TL=R*tan(TR2):DCL=R*TBIA:SL=R*(1#/cos(TR2)-1#)
DM=R*(1#-cos(TR2)):DC=2#*R*sin(TR2)
return
'
*STSUB:'---------ST SUB---------
SS=sqr(DX*DX+DY*DY):TD=atn(DY/(DX+EE)):TT=TD*RAA
if DX<0 then TT=TT+180#
if DY<0 then TT=TT+360#
TD=TT*RRA
return
'
*KOUTENSUB:'--------交点 SUB---------
XX=(T2*X2-T1*X1+Y1-Y2)/(T2-T1):YY=T1*(XX-X1)+Y1
DX=X1-XX:DY=Y1-YY:gosub *STSUB:TT1=TT:TD1=TD:SS1=SS
DX=X2-XX:DY=Y2-YY:gosub *STSUB:TT2=TT:TD2=TD:SS2=SS
return
'
*ENCYOKUSUB:'------------直線と円の交点 SUB----------
T3=T1*T1+1#:T4=sqr(R0*R0*T3-T2*T2)
XP1=(T1*T2+T4)/T3+X(3):YP1=*6:DAT=atn(DATT)
DCOS=PI/2#-DAT:DRA=DCOS
TN=TA0:gosub *7010:TN0=TN:TR1=TN0+DCOS:TR2=TN0-DCOS
XP1=X(1)+cos(TR1)*R1:YP1=Y(1)+sin(TR1)*R1
XP2=X(1)+cos(TR2)*R1:YP2=Y(1)+sin(TR2)*R1
return
'
*ENDD1
'
end
