' ************************************************************************** ' * Programa de conversao entre varios sistemas de coordenadas * ' * Licenciatura de Fisica / Matematica Aplicada - Ramo Astronomia * ' * Realizado por: * ' * Jose "Ant" Silva * ' * e * ' * Ricardo "Spawn" Reis * ' * Concede-se permissao para usar este programa para fins educativos * ' ************************************************************************** ' Declaracao das contantes PI e Obliquidade da Ecliptica CONST PI = 3.141593 CONST OE = .41 ' ************************************************************************** ' Declaracao das subrotinas para as matrizes de rotacao DECLARE SUB MATRIx (A!, X!, Y!, Z!, XL!, YL!, ZL!) DECLARE SUB MATRIy (A!, X!, Y!, Z!, XL!, YL!, ZL!) DECLARE SUB MATRIz (A!, X!, Y!, Z!, XL!, YL!, ZL!) ' ************************************************************************** ' Declaracao das subrotinas para a conversao entre alguns sistemas DECLARE SUB CHGgr (A!, B!) DECLARE SUB CHGrg (A!, B!) DECLARE SUB CHGgh (G!, H!, M!, S!) DECLARE SUB CHGhg (H!, M!, S!, G!) DECLARE SUB CHGne (B!, A!, X!, Y!, Z!) DECLARE SUB CHGen (XL!, YL!, ZL!, A!, B!) ' ************************************************************************** ' Declaracao da subrotina para pausa do programa DECLARE SUB PAUSA () ' ************************************************************************** ' Apresentando o menu ... MENU: CLS SCREEN 12 COLOR 11 LOCATE 5 PRINT " Programa de conversao de coordenadas" COLOR 15 LOCATE 10 PRINT " Escolha as coordenadas iniciais : " PRINT PRINT " 1 - Horizontais " PRINT " 2 - Equatoriais locais" PRINT " 3 - Equatoriais celestes" PRINT " 4 - Eclipticas" LOCATE 20 PRINT " S - Sair" LOCATE 23 COLOR 10 INPUT ; " Escolha uma das opcoes: ", OP1$ IF OP1$ = "S" OR OP1$ = "s" THEN GOTO SAIDA IF OP1$ = "1" THEN GOTO HZ IF OP1$ = "2" THEN GOTO EQLOC IF OP1$ = "3" THEN GOTO EQCEL IF OP1$ = "4" THEN GOTO ECL GOTO MENU ' ************************************************************************* ' Introducao de Coordenadas Horizontais HZ: CLS LOCATE 3 COLOR 10 PRINT SPC(26); "Coordenadas Horizontais" COLOR 15 PRINT PRINT PRINT " Introduzir coordenadas: " LOCATE 10 INPUT " Azimute: ", AZI IF AZI > 360 OR AZI < 0 THEN GOTO HZ INPUT " Altura: ", ALT IF ABS(ALT) > 90 THEN GOTO HZ INPUT " Latitude: ", LAT IF ABS(LAT) > 90 THEN GOTO HZ LOCATE 16 PRINT " Introduzir o Tempo Sideral Local do instante da observacao: " LOCATE 20 INPUT " Horas: ", H IF H < 0 OR H > 24 THEN GOTO HZ INPUT " Minutos: ", M IF M < 0 OR M > 59 THEN GOTO HZ IF H = 24 AND M <> 0 THEN GOTO HZ INPUT " Segundos: ", S IF S < 0 OR S > 59 THEN GOTO HZ IF H = 24 AND S <> 0 THEN GOTO HZ GOTO MENUFINAL ' ************************************************************************* ' Introducao de Coordenadas Equatoriais Locais EQLOC: CLS LOCATE 3 COLOR 10 PRINT SPC(23); "Coordenadas Equatoriais Locais" COLOR 15 PRINT PRINT PRINT " Introduzir coordenadas: " LOCATE 10 PRINT " Angulo Horario:" INPUT " Horas: ", H IF H < 0 OR H > 24 THEN GOTO EQLOC INPUT " Minutos: ", M IF M < 0 OR M > 59 THEN GOTO EQLOC IF H = 24 AND M <> 0 THEN GOTO EQLOC INPUT " Segundos: ", S IF S < 0 OR S > 59 THEN GOTO EQLOC IF H = 24 AND S <> 0 THEN GOTO EQLOC PRINT INPUT " Declinacao: ", DEC IF ABS(DEC) > 90 THEN GOTO EQLOC PRINT INPUT " Latitude:", LAT IF ABS(LAT) > 90 THEN GOTO EQLOC LOCATE 20 PRINT " Introduzir o Tempo Sideral Local do instante da observacao: " LOCATE 22 INPUT " Horas: ", H IF H < 0 OR H > 24 THEN GOTO EQLOC INPUT " Minutos: ", M IF M < 0 OR M > 59 THEN GOTO EQLOC IF H = 24 AND M <> 0 THEN GOTO EQLOC INPUT " Segundos: ", S IF S < 0 OR S > 59 THEN GOTO EQLOC IF H = 24 AND S <> 0 THEN GOTO EQLOC GOTO MENUFINAL ' ************************************************************************* ' Introducao de Coordenadas Equatoriais Celestes EQCEL: CLS LOCATE 3 COLOR 10 PRINT SPC(23); "Coordenadas Equatoriais Celestes" COLOR 15 PRINT PRINT PRINT " Introduzir coordenadas:" LOCATE 10 PRINT " Ascencao recta: " INPUT " Horas: ", H IF H < 0 OR H > 24 THEN GOTO EQCEL INPUT " Minutos: ", M IF M < 0 OR M > 59 THEN GOTO EQCEL IF H = 24 AND M <> 0 THEN GOTO EQCEL INPUT " Segundos: ", S IF S < 0 OR S > 59 THEN GOTO EQCEL IF H = 24 AND S <> 0 THEN GOTO EQCEL PRINT INPUT " Declinacao: ", DEC IF ABS(DEC) > 90 THEN GOTO EQCEL PRINT INPUT " Latitude: ", LAT IF ABS(LAT) > 90 THEN GOTO EQCEL LOCATE 20 PRINT " Introduzir o Tempo Sideral Local do instante da observacao: " LOCATE 23 INPUT " Horas: ", H IF H < 0 OR H > 24 THEN GOTO EQCEL INPUT " Minutos: ", M IF M < 0 OR M > 59 THEN GOTO EQCEL IF H = 24 AND M <> 0 THEN GOTO EQCEL INPUT " Segundos: ", S IF S < 0 OR S > 59 THEN GOTO EQCEL IF H = 24 AND S <> 0 THEN GOTO EQCEL GOTO MENUFINAL ' ************************************************************************* ' Introducao de Coordenadas Eclipticas ECL: CLS LOCATE 3 COLOR 10 PRINT SPC(23); "Coordenadas Eclipticas" COLOR 15 PRINT PRINT PRINT " Introduzir coordenadas: " LOCATE 10 INPUT " Longitude ecliptica: ", LOE IF LOE < 0 OR LOE > 360 THEN GOTO ECL PRINT INPUT " Latitude ecliptica: ", LAE IF ABS(LAE) > 90 THEN GOTO ECL PRINT INPUT " Latitude: ", LAT IF ABS(LAT) > 90 THEN GOTO ECL LOCATE 19 PRINT " Introduzir o Tempo Sideral Local do instante da observacao: " LOCATE 21 INPUT " Horas: ", H IF H < 0 OR H > 24 THEN GOTO ECL INPUT " Minutos: ", M IF M < 0 OR M > 59 THEN GOTO ECL IF H = 24 AND M <> 0 THEN GOTO ECL INPUT " Segundos: ", S IF S < 0 OR S > 59 THEN GOTO ECL IF H = 24 AND S <> 0 THEN GOTO HZ GOTO MENUFINAL GOTO MENU ' ************************************************************************* ' Apresentando Menu Coordenadas finais ... MENUFINAL: CLS LOCATE 10 PRINT " Introduza as coordenadas finais: " PRINT PRINT PRINT " 1 - Horizontais " PRINT " 2 - Equatoriais locais" PRINT " 3 - Equatoriais celestes" PRINT " 4 - Eclipticas" LOCATE 20 PRINT " V - Voltar" PRINT " S - Sair" LOCATE 25 COLOR 10 INPUT " Escolha a opcao:", OP2$ COLOR 15 IF OP2$ = "s" OR OP2$ = "S" THEN GOTO SAIDA IF OP2$ = "v" OR OP2$ = "V" THEN GOTO VOLTAR IF OP2$ = OP1$ THEN GOTO MENUFINAL IF OP1$ = "1" AND OP2$ = "2" THEN GOTO HEQLOCFNL IF OP1$ = "1" AND OP2$ = "3" THEN GOTO HEQCELFNL IF OP1$ = "1" AND OP2$ = "4" THEN GOTO HECLFNL IF OP1$ = "2" AND OP2$ = "1" THEN GOTO ELHRZFNL IF OP1$ = "2" AND OP2$ = "3" THEN GOTO ELEQCELFNL IF OP1$ = "2" AND OP2$ = "4" THEN GOTO ELECLFNL IF OP1$ = "3" AND OP2$ = "1" THEN GOTO ECHRZFNL IF OP1$ = "3" AND OP2$ = "2" THEN GOTO ECEQLOCFNL IF OP1$ = "3" AND OP2$ = "4" THEN GOTO ECECLFNL IF OP1$ = "4" AND OP2$ = "1" THEN GOTO ECLHRZFNL IF OP1$ = "4" AND OP2$ = "2" THEN GOTO ECLEQLOCFNL IF OP1$ = "4" AND OP2$ = "3" THEN GOTO ECLEQCELFNL ' ************************************************************************** ' Conversao de coordenadas horizontais para coordenadas equatoriais locais HEQLOCFNL: CLS CALL CHGgr(AZI, AZIr) CALL CHGgr(ALT, ALTr) CALL CHGgr(LAT, LATr) CALL CHGne(AZIr, ALTr, X, Y, Z) CALL MATRIy((PI / 2 - LATr), X, Y, Z, XL, YL, ZL) CALL CHGen(XL, YL, ZL, Tr, DECr) CALL CHGrg(Tr, T) CALL CHGrg(DECr, DEC) CALL CHGgh(T, H, M, S) LOCATE 5 PRINT " Coordenadas finais:" LOCATE 10 PRINT " Angulo Horario:" PRINT " Horas: "; H PRINT " Minutos: "; M PRINT " Segundos: "; S PRINT PRINT " Declinacao: "; USING "###.##"; DEC CALL PAUSA GOTO SAIDA ' ************************************************************************** ' Conversao de coordenadas horizontais para coordenadas equatoriais celestes HEQCELFNL: CLS CALL CHGgr(AZI, AZIr) CALL CHGgr(ALT, ALTr) CALL CHGgr(LAT, LATr) CALL CHGne(AZIr, ALTr, X, Y, Z) CALL MATRIy((PI / 2 - LATr), X, Y, Z, XL, YL, ZL) CALL CHGhg(H, M, SS, TS) CALL CHGgr(TS, TSr) CALL MATRIz(-TSr, XL, YL, ZL, X, Y, Z) CALL CHGen(X, Y, Z, Tr, DECr) CALL CHGrg(Tr, T) CALL CHGrg(DECr, DEC) CALL CHGgh(T, H, M, S) LOCATE 5 PRINT " Coordenadas finais:" LOCATE 10 PRINT " Ascencao recta: " PRINT " Horas: "; H PRINT " Minutos: "; M PRINT " Segundos: "; S PRINT PRINT " Declinacao: "; USING "###.##"; DEC CALL PAUSA GOTO SAIDA ' ************************************************************************** ' Conversao de coordenadas horizontais para coordenadas eclipticas HECLFNL: CALL CHGgr(AZI, AZIr) CALL CHGgr(ALT, ALTr) CALL CHGgr(LAT, LATr) CALL CHGne(AZIr, ALTr, X, Y, Z) CALL MATRIy((PI / 2 - LATr), X, Y, Z, XL, YL, ZL) CALL CHGhg(H, M, SS, TS) CALL CHGgr(TS, TSr) CALL MATRIz(-TSr, XL, YL, ZL, X, Y, Z) CALL MATRIx(OE, X, Y, Z, XL, YL, ZL) CALL CHGen(XL, YL, ZL, LOEr, LAEr) CALL CHGrg(LOEr, LOE) CALL CHGrg(LAEr, LAE) CLS LOCATE 5 PRINT "Coordenadas finais:" LOCATE 10 PRINT " Longitude ecliptica: "; USING "###.##"; LOE PRINT " Latitude ecliptica: "; USING "###.##"; LAE CALL PAUSA GOTO SAIDA ' ************************************************************************** ' Conversao de coordenadas equatoriais locais para coordenadas horizontais ELHRZFNL: CALL CHGhg(H, M, S, T) CALL CHGgr(T, Tr) CALL CHGgr(DEC, DECr) CALL CHGgr(LAT, LATr) CALL CHGne(Tr, DECr, X, Y, Z) CALL MATRIy(LATr - PI / 2, X, Y, Z, XL, YL, ZL) CALL CHGen(XL, YL, ZL, AZIr, ALTr) CALL CHGrg(AZIr, AZI) CALL CHGrg(ALTr, ALT) CLS LOCATE 5 PRINT "Coordenadas finais:" LOCATE 8 PRINT " Azimute: "; USING "###.##"; AZI PRINT " Altura: "; USING "###.##"; ALT PRINT " Latitude: "; USING "###.##"; LAT CALL PAUSA GOTO SAIDA ' ************************************************************************** ' Conversao de coordenadas equatoriais locais para coordenadas equatoriais ' celestes ELEQCELFNL: CALL CHGhg(H, M, S, T) CALL CHGgr(T, Tr) CALL CHGgr(DEC, DECr) CALL CHGgr(LAT, LATr) CALL CHGne(Tr, DECr, X, Y, Z) CALL MATRIz(-TSr, XL, YL, ZL, X, Y, Z) CALL CHGen(X, Y, Z, Tr, DECr) CALL CHGrg(Tr, T) CALL CHGrg(DECr, DEC) CALL CHGgh(T, H, M, S) CLS LOCATE 5 PRINT " Coordenadas finais:" LOCATE 10 PRINT " Ascencao recta: " PRINT " Horas: "; H PRINT " Minutos: "; M PRINT " Segundos: "; S PRINT PRINT " Declinacao: "; USING "###.##"; DEC CALL PAUSA GOTO SAIDA ' ************************************************************************** ' Conversao de coordenadas equatoriais locais para coordenadas eclipticas ELECLFNL: CALL CHGhg(H, M, S, T) CALL CHGgr(T, Tr) CALL CHGgr(DEC, DECr) CALL CHGgr(LAT, LATr) CALL CHGne(Tr, DECr, X, Y, Z) CALL MATRIz(-TSr, XL, YL, ZL, X, Y, Z) CALL MATRIx(OE, X, Y, Z, XL, YL, ZL) CALL CHGen(XL, YL, ZL, LOEr, LAEr) CALL CHGrg(LOEr, LOE) CALL CHGrg(LAEr, LAE) CLS LOCATE 5 PRINT "Coordenadas finais:" LOCATE 10 PRINT " Longitude ecliptica: "; USING "###.##"; LOE PRINT " Latitude ecliptica: "; USING "###.##"; LAE CALL PAUSA GOTO SAIDA ' ************************************************************************** ' Conversao de coordenadas equatoriais celestes para coordenadas horizontais ECHRZFNL: CLS CALL CHGhg(T, H, M, S) CALL CHGgr(T, Tr) CALL CHGgr(DEC, DECr) CALL CHGne(Tr, DECr, X, Y, Z) CALL CHGhg(H, M, SS, TS) CALL CHGgr(TS, TSr) CALL MATRIz(TSr, X, Y, Z, XL, YL, ZL) CALL CHGgr(LAT, LATr) CALL MATRIy((-(PI / 2) + LATr), XL, YL, ZL, X, Y, Z) CALL CHGen(X, Y, Z, AZIr, ALTr) CALL CHGrg(ALTr, ALT) CALL CHGrg(AZIr, AZI) LOCATE 5 PRINT "Coordenadas finais:" LOCATE 8 PRINT " Azimute: "; USING "###.##"; AZI PRINT " Altura: "; USING "###.##"; ALT PRINT " Latitude: "; USING "###.##"; LAT CALL PAUSA GOTO SAIDA ' ************************************************************************** ' Conversao de coordenadas equatoriais celestes para coordenadas equatoriais ' celestes ECEQLOCFNL: CLS CALL CHGhg(T, H, M, S) CALL CHGgr(T, Tr) CALL CHGgr(DEC, DECr) CALL CHGne(Tr, DECr, X, Y, Z) CALL CHGhg(H, M, SS, TS) CALL CHGgr(TS, TSr) CALL MATRIz(TSr, X, Y, Z, XL, YL, ZL) CALL CHGen(XL, YL, ZL, Tr, DECr) CALL CHGrg(Tr, T) CALL CHGrg(DECr, DEC) CALL CHGgh(T, H, M, S) LOCATE 5 PRINT " Coordenadas finais:" LOCATE 10 PRINT " Angulo Horario:" PRINT " Horas: "; H PRINT " Minutos: "; M PRINT " Segundos: "; S PRINT PRINT " Declinacao: "; USING "###.##"; DEC CALL PAUSA GOTO SAIDA ' ************************************************************************** ' Conversao de coordenadas equatoriais celestes para coordenadas eclipticas ECECLFNL: CLS CALL CHGhg(T, H, M, S) CALL CHGgr(T, Tr) CALL CHGgr(DEC, DECr) CALL CHGne(Tr, DECr, X, Y, Z) CALL MATRIx(OE, X, Y, Z, XL, YL, ZL) CALL CHGen(XL, YL, ZL, LOEr, LAEr) CALL CHGrg(LOEr, LOE) CALL CHGrg(LAEr, LAE) LOCATE 5 PRINT " Coordenadas finais:" LOCATE 10 PRINT " Longitude ecliptica: "; USING "###.##"; LOE PRINT " Latitude ecliptica: "; USING "###.##"; LAE CALL PAUSA GOTO SAIDA ' ************************************************************************** ' Conversao de coordenadas eclipticas para coordenadas horizontais ECLHRZFNL: CLS CALL CHGgr(LOE, LOEr) CALL CHGgr(LAE, LAEr) CALL CHGne(LOEr, LAEr, XL, YL, ZL) CALL MATRIx(-OE, XL, YL, ZL, X, Y, Z) CALL CHGhg(H, M, SS, TS) CALL CHGgr(TS, TSr) CALL MATRIz(TSr, X, Y, Z, XL, YL, ZL) CALL CHGgr(LAT, LATr) CALL MATRIy((-(PI / 2) + LATr), XL, YL, ZL, X, Y, Z) CALL CHGen(X, Y, Z, AZIr, ALTr) CALL CHGrg(ALTr, ALT) CALL CHGrg(AZIr, AZI) LOCATE 5 PRINT "Coordenadas finais:" LOCATE 8 PRINT " Azimute: "; USING "###.##"; AZI PRINT " Altura: "; USING "###.##"; ALT PRINT " Latitude: "; USING "###.##"; LAT CALL PAUSA GOTO SAIDA ' ************************************************************************** ' Conversao de coordenadas eclipticas para coordenadas equatoriais locais ECLEQLOCFNL: CLS CALL CHGgr(LOE, LOEr) CALL CHGgr(LAE, LAEr) CALL CHGne(LOEr, LAEr, XL, YL, ZL) CALL MATRIx(-OE, XL, YL, ZL, X, Y, Z) CALL CHGhg(H, M, SS, TS) CALL CHGgr(TS, TSr) CALL MATRIz(TSr, X, Y, Z, XL, YL, ZL) CALL CHGen(XL, YL, ZL, Tr, DECr) CALL CHGrg(Tr, T) CALL CHGrg(DECr, DEC) CALL CHGgh(T, H, M, S) LOCATE 5 PRINT " Coordenadas finais:" LOCATE 10 PRINT " Angulo Horario:" PRINT " Horas: "; H PRINT " Minutos: "; M PRINT " Segundos: "; S PRINT PRINT " Declinacao: "; USING "###.##"; DEC CALL PAUSA GOTO SAIDA ' ************************************************************************** ' Conversao de coordenadas eclipticas para coordenadas equatoriais celestes ECLEQCELFNL: CLS CALL CHGgr(LOE, LOEr) CALL CHGgr(LAE, LAEr) CALL CHGne(LOEr, LAEr, XL, YL, ZL) CALL MATRIx(-OE, XL, YL, ZL, X, Y, Z) CALL CHGen(X, Y, Z, Tr, DECr) CALL CHGrg(Tr, T) CALL CHGrg(DECr, DEC) CALL CHGgh(T, H, M, S) LOCATE 5 PRINT " Coordenadas finais:" LOCATE 10 PRINT " Ascencao recta: " PRINT " Horas: "; H PRINT " Minutos: "; M PRINT " Segundos: "; S PRINT PRINT " Declinacao: "; USING "###.##"; DEC CALL PAUSA GOTO SAIDA ' ************************************************************************** ' Reinicia o programa voltando ao menu inicial VOLTAR: RUN ' ************************************************************************** ' Saida do programa com apresentacao dos creditos SAIDA: CLS LOCATE 6 COLOR 12 PRINT SPC(8); "Programa realizado por : " LOCATE 9 COLOR 15 PRINT SPC(20); "Jose Antonio do Bem Ferreira da Silva" PRINT PRINT SPC(38); "e" PRINT PRINT SPC(20); "Ricardo Samuel dos Santos Cardoso Reis" LOCATE 18 COLOR 14 PRINT SPC(10); "Curso : Fisica / Matematica Aplicada - Ramo Astronomia" LOCATE 25 COLOR 9 PRINT SPC(18); "Faculdade de Ciencias da Universidade do Porto " PRINT PRINT COLOR 15 PRINT " Prima Esc para sair ..." DO LOOP UNTIL INKEY$ = CHR$(27) COLOR 0 END ' ************************************************************************** ' Subrotina para mudar sistema de tres coordenadas para duas coordenadas SUB CHGen (XL, YL, ZL, A, B) STATIC A = ATN(YL / XL) + PI B = ATN(ZL / ((XL ^ 2 + YL ^ 2) ^ (1 / 2))) END SUB ' ************************************************************************** ' Subrotina para converter graus em horas SUB CHGgh (G, H, M, S) STATIC H2 = (G * 24) / 360 H = INT(H2) M = INT((H2 - H) * 60) S = INT((((H2 - H) * 60) - M) * 60) END SUB ' ************************************************************************** ' Subrotina para mudar de graus para radianos SUB CHGgr (A, B) STATIC B = A * PI / 180 END SUB ' ************************************************************************** ' Subrotina para mudar horas para graus SUB CHGhg (H, M, S, G) HT = H + (M / 60) + (S / 3600) G = (HT * 360) / 24 END SUB ' ************************************************************************** ' Subrotina para mudar sistema de duas coordenadas para tres coordenadas SUB CHGne (A, B, X, Y, Z) STATIC X = COS(B) * COS(A) Y = COS(B) * SIN(A) Z = SIN(B) END SUB ' ************************************************************************** ' Subrotina para mudar radianos para graus SUB CHGrg (A, B) STATIC B = (A * 180) / PI END SUB ' ************************************************************************** ' Subrotina para fazer a rotacao do sistema de eixos sobre o eixo dos xx SUB MATRIx (A, X, Y, Z, XL, YL, ZL) STATIC DIM Mx(3, 3), Me(3, 3) Mx(1, 1) = 1 Mx(1, 2) = 0 Mx(1, 3) = 0 Mx(2, 1) = 0 Mx(2, 2) = COS(A) Mx(2, 3) = SIN(A) Mx(3, 1) = 0 Mx(3, 2) = -SIN(A) Mx(3, 3) = COS(A) Me(1, 1) = X Me(2, 1) = Y Me(3, 1) = Z FOR C = 1 TO 3 XL = XL + Mx(1, C) * Me(C, 1) YL = YL + Mx(2, C) * Me(C, 1) ZL = ZL + Mx(3, C) * Me(C, 1) NEXT C END SUB ' ************************************************************************** ' Subrotina para fazer a rotacao do sistema de eixos sobre o eixo dos yy SUB MATRIy (A, X, Y, Z, XL, YL, ZL) STATIC DIM Mx(3, 3), Me(3, 3) Mx(1, 1) = COS(A) Mx(1, 2) = 0 Mx(1, 3) = -SIN(A) Mx(2, 1) = 0 Mx(2, 2) = 1 Mx(2, 3) = 0 Mx(3, 1) = SIN(A) Mx(3, 2) = 0 Mx(3, 3) = COS(A) Me(1, 1) = X Me(2, 1) = Y Me(3, 1) = Z FOR C = 1 TO 3 XL = XL + Mx(1, C) * Me(C, 1) YL = YL + Mx(2, C) * Me(C, 1) ZL = ZL + Mx(3, C) * Me(C, 1) NEXT C END SUB ' ************************************************************************** ' Subrotina para fazer a rotacao do sistema de eixos sobre o eixo dos zz SUB MATRIz (A, X, Y, Z, XL, YL, ZL) STATIC DIM Mx(3, 3), Me(3, 3) Mx(1, 1) = COS(A) Mx(1, 2) = SIN(A) Mx(1, 3) = 0 Mx(2, 1) = -SIN(A) Mx(2, 2) = COS(A) Mx(2, 3) = 0 Mx(3, 1) = 0 Mx(3, 2) = 0 Mx(3, 3) = 1 Me(1, 1) = X Me(2, 1) = Y Me(3, 1) = Z FOR C = 1 TO 3 XL = XL + Mx(1, C) * Me(C, 1) YL = YL + Mx(2, C) * Me(C, 1) ZL = ZL + Mx(3, C) * Me(C, 1) NEXT C ' ************************************************************************** ' Inverte-se a coordenada por causa de ser um sistema retrogrado YL = -YL END SUB ' ************************************************************************** ' Subrotina para pausar o programa SUB PAUSA STATIC LOCATE 28 PRINT "Prima tecla para continuar..." DO LOOP WHILE INKEY$ = "" END SUB ' ************************************************************************** ' O FIM ' ************************************************************************** ' * Concede-se permissao para usar este programa para fins educativos * ' **************************************************************************
Copyright © 1996-1999
Jose António Silva et al.
Todos os Direitos Reservados.
Por favor não utilize para outros fins que não educacionais.