A medida que cree programas los iré subiendo, si puedo haré un vídeo tutorial.
Les dejamos unas fotos y a continuación el programa.
Programas:
10 CLS:PRINT "Coord Transformation Program:":CLS:SET N
20 PRINT "Old x1:";ox1;:INPUT ox1:PRINT "Old y1:";oy1;:INPUT oy1:CLS
30 PRINT "Old x2:";ox2;:INPUT ox2:PRINT "Old y2:";oy2;:INPUT oy2:CLS
40 PRINT "New x1:";nx1;:INPUT nx1:PRINT "New y1:";ny1;:INPUT ny1:CLS
50 PRINT "New x2:";nx2;:INPUT nx2:PRINT "New y2:";ny2;:INPUT ny2:CLS
60 Z=POL((ox2-ox1),(oy2-oy1)):brgold=90-Y:baseold=Z
70 Z=POL((nx2-nx1),(ny2-ny1)):brgnew=90-Y:basenew=Z
80 SF=basenew/baseold:mm=ABS(1000000-(SF*1000000))
90 BEEP 0:PRINT "Old:";ROUND(baseold,-5);TAB(16);"New:";ROUND(basenew,-5);TAB(32);"SF:";ROUND(SF,-7);TAB(45);ROUND(mm,-2);"per Km":CLS
100 deltabrg=brgold-brgnew
110 B=SF*COS(deltabrg):YY=SF*SIN(deltabrg)
120 E0=nx1-(ox1*B)+(oy1*YY):N0=ny1-(ox1*YY)-(oy1*B)
130 PRINT "Old x3:";ox3;:INPUT ox3:PRINT "Old y3:";oy3;:INPUT oy3:CLS
140 nx3=E0+(ox3*B)-(oy3*YY):ny3=N0+(ox3*YY)+(oy3*B)
150 Z=POL((nx1-nx3),(ny1-ny3)):brg31=90-Y:IF brg31<0 THEN brg31=brg31+360
160 Z=POL((nx2-nx3),(ny2-ny3)):brg32=90-Y:IF brg32<0 THEN brg32=brg32+360
170 BEEP 0:PRINT "New x3:";ROUND(nx3,-5);TAB(32);"New y3:";ROUND(ny3,-5):CLS
180 BEEP 0:PRINT "Brg to 1:";DMS$(brg31);TAB(32);"Brg to 2:";DMS$(brg32):CLS:GOTO 130
5 CLS:PRINT "3-D Circle Fix Program:"
10 CLS:SET N
15 PRINT "x1:";xa;:INPUT xa:PRINT "y1:";ya;:INPUT ya:PRINT "z1:";za;:INPUT za:CLS
20 PRINT "x2:";xb;:INPUT xb:PRINT "y2:";yb;:INPUT yb:PRINT "z2:";zb;:INPUT zb:CLS
30 PRINT "x3:";xc;:INPUT xc:PRINT "y3:";yc;:INPUT yc:PRINT "z3:";zc;:INPUT zc:CLS
40 PRINT "Wait...";
50 dac=SQR(ABS(xa-xc)^2+ABS(ya-yc)^2+ABS(za-zc)^2
60 dab=SQR(ABS(xa-xb)^2+ABS(ya-yb)^2+ABS(za-zb)^2
70 dbc=SQR(ABS(xb-xc)^2+ABS(yb-yc)^2+ABS(zb-zc)^2
80 acos=((dac^2+dab^2-dbc^2)/(2*dac*dab)):bcos=((dab^2+dbc^2-dac^2)/(2*dab*dbc))
90 anga=90-ATN(acos/SQR(1-acos^2)):angb=90-ATN(bcos/SQR(1-bcos^2)):angc=180-(anga+angb)
100 IF anga<90 AND angb<90 AND dab>dac AND dab>dbc THEN GOTO 150
110 IF NOT(anga>90 OR angb>90) THEN GOTO 150
120 IF dab>dac AND dab>dbc THEN IF anga>90 THEN GOSUB 240 ELSE GOSUB 260
130 IF dac>dab AND dac>dbc THEN GOSUB 260 ELSE GOSUB 240
140 GOTO 50
150 ra=(dbc/2)/COS(90-anga):daz=(dac/2)/acos:p1=daz/dab
160 ez=xa-((xa-xb)*p1):nz=ya-((ya-yb)*p1):hz=za-((za-zb)*p1)
170 em=(xa+xc)/2:nm=(ya+yc)/2:hm=(za+zc)/2
180 dmz=SQR((ez-em)^2+(nz-nm)^2+(hz-hm)^2:dmo=SQR(ra^2-((dac/2)^2)):p2=dmo/dmz
190 ep=em-((em-ez)*p2):np=nm-((nm-nz)*p2):hp=hm-((hm-hz)*p2)
200 diam=SQR((ep-xa)^2+(np-ya)^2+(hp-za)^2)*2
210 CLS:SET F3:BEEP 0:PRINT "E: ";ep;TAB(16);"N: ";np;TAB(32);"H: ";hp;TAB(48);"D: ";diam
230 GOTO 10
240 txc=xc:xc=xa:xa=txc:tyc=yc:yc=ya:ya=tyc:tzc=zc:zc=za:za=tzc
250 RETURN
260 txc=xc:xc=xb:xb=txc:tyc=yc:yc=yb:yb=tyc:tzc=zc:zc=zb:zb=tzc
270 RETURN
10 CLS:PRINT "Angle Reduction Program:":CLS:SET N
20 PRINT "Stn E:";SE;:INPUT SE:PRINT "Stn N:";SN;:INPUT SN:CLS
30 PRINT "Stn Level:";RL;:INPUT RL:PRINT "Inst Ht:";IH;:INPUT IH:CLS
40 CLS:PRINT " [B] Bearing to RO [C] Coords of RO";
50 I$=INKEY$
60 IF I$="C" OR I$="c" THEN 80
70 IF I$="B" OR I$="b" THEN GOTO 90 ELSE 50
80 CLS:PRINT "RO Stn E:";ROE;:INPUT ROE:PRINT "RO Stn N:";RON;:INPUT RON:CLS:GOTO 80
90 CLS:PRINT "RO Brg:";DMS$(ROBEAR);:INPUT ROBEAR
100 CLS:PRINT "Horz Ang:";DMS$(HZANG);:INPUT HZANG:PRINT "Vert Ang:";DMS$(VA);:INPUT VA:CLS
110 PRINT "Slope Dist:";SLOPE;:INPUT SLOPE:PRINT "Target Ht:";TH;:INPUT TH:CLS:PRINT "Wait...";
120 IF I$="B" OR I$="b" THEN GOTO 110
130 Z=POL((ROE-SE),(RON-SN)):ROBEAR=90-Y:IF ROBEAR<0 THEN ROBEAR=ROBEAR+360
140 HZBEAR=ROBEAR+HZANG
150 HZDIST=COS(90-VA)*SLOPE
160 PTE=SIN(HZBEAR)*HZDIST+SE:PTN=COS(HZBEAR)*HZDIST+SN
170 PTH=TAN(90-VA)*HZDIST+RL+IH-TH
180 CLS:BEEP 0:PRINT "x:";ROUND(PTE,-6);TAB(16);"y:";ROUND(PTN,-6);TAB(32);"z:";ROUND(PTH,-5);TAB(47);"Hz:";ROUND(HZDIST,-5)
190 CLS:GOTO 100
10 CLS:PRINT "Bearing & Distance Program:":CLS:SET N
20 PRINT "x1 =";x1;:INPUT x1:PRINT "y1 =";y1;:INPUT y1:CLS
30 PRINT "x2 =";x2;:INPUT x2:PRINT "y2 =";y2;:INPUT y2:CLS:PRINT "Wait...";
40 Z=POL((x2-x1),(y2-y1)):BRG=90-Y:DIST=X:IF BRG<0 THEN BRG=BRG+360
50 CLS:BEEP 0:PRINT "Bearing: ";DMS$(BRG);TAB(32);"Distance: ";ROUND(DIST,-5)
60 CLS:GOTO 20
10 CLS:PRINT "Extension of Vectors Program:":CLS:SET N
20 PRINT "x1 =";vx1;:INPUT vx1:PRINT "y1 =";vy1;:INPUT vy1:CLS
30 PRINT "x1 =";vx1;TAB(16);"y1 =";vy1;TAB(32);"z1 =";vz1;:INPUT vz1:CLS
40 PRINT "x2 =";vx2;:INPUT vx2:PRINT "y2 =";vy2;:INPUT vy2:CLS
50 PRINT "x2 =";vx2;TAB(16);"y2 =";vy2;TAB(32);"z2 =";vz2;:INPUT vz2:CLS
60 PRINT "Extension =";v23;:INPUT v23:CLS:PRINT "Wait...";
70 vx12=vx2-vx1:vy12=vy2-vy1:vz12=vz2-vz1
80 v12=SQR(vx12^2+vy12^2+vz12^2)
90 vx3=vx2+((vx12/v12)*v23)
100 vy3=vy2+((vy12/v12)*v23)
110 vz3=vz2+((vz12/v12)*v23)
120 CLS:BEEP 0:PRINT "x3: ";ROUND(vx3,-4);TAB(16);"y3: ";ROUND(vy3,-4);TAB(32);"z3: ";ROUND(vz3,-4);TAB(47);"1-2: ";ROUND(v12,-4)
130 CLS:GOTO 20
10 CLS:PRINT "Intersection Program:":CLS:SET N
20 PRINT "Left Stn E:";LSE;:INPUT LSE:PRINT "Left Stn N:";LSN;:INPUT LSN:CLS
30 PRINT "Left RL:";LRL;:INPUT LRL:PRINT "Left IH:";LIH;:INPUT LIH:CLS
40 PRINT " [B] Bearing to RO [C] Coords of RO";
50 I$=INKEY$:IF I$="" THEN 50
60 IF I$="B" OR I$="b" THEN 110
70 IF I$="C" OR I$="c" THEN 80 ELSE GOTO 50
80 CLS:PRINT "Left RO E:";LROE;:INPUT LROE:PRINT "Left RO N:";LRON;:INPUT LRON:CLS
90 Z=POL((LROE-LSE),(LRON-LSN)):LRO=90-Y:IF LRO<0 THEN LRO=LRO+360
100 GOTO 120
110 CLS:PRINT "Left RO:";DMS$(LRO);:INPUT LRO:CLS
120 PRINT "Right Stn E:";RSE;:INPUT RSE:PRINT "Right Stn N:";RSN;:INPUT RSN:CLS
130 PRINT "Right RL:";RRL;:INPUT RRL:PRINT "Right IH:";RIH;:INPUT RIH:CLS
140 PRINT " [B] Bearing to RO [C] Coords of RO";
150 I$=INKEY$:IF I$="" THEN 150
160 IF I$="B" OR I$="b" THEN 210
170 IF I$="C" OR I$="c" THEN 180 ELSE GOTO 150
180 CLS:PRINT "Right RO E:";RROE;:INPUT RROE:PRINT "Right RO N:";RRON;:INPUT RRON:CLS
190 Z=POL((RROE-RSE),(RRON-RSN)):RRO=90-Y:IF RRO<0 THEN RRO=RRO+360
200 GOTO 220
210 CLS:PRINT "Right RO:";DMS$(RRO);:INPUT RRO:CLS
220 PRINT "Left HA:";DMS$(LHA);:INPUT LHA:PRINT "Left VA:";DMS$(LVA);:INPUT LVA:CLS
230 PRINT "Right HA:";DMS$(RHA);:INPUT RHA:PRINT "Right VA:";DMS$(RVA);:INPUT RVA:CLS
240 PRINT "Wait...";:LAZ=LRO+LHA:RAZ=RRO+RHA
250 XP=((RSE*(1/TAN(RAZ)))-(LSE*(1/TAN(LAZ)))-RSN+LSN)/((1/TAN(RAZ))-(1/TAN(LAZ)))
260 YP=((RSN*TAN(RAZ))-(LSN*TAN(LAZ))-RSE+LSE)/(TAN(RAZ)-(TAN(LAZ))
270 LDIST=SQR((LSE-XP)^2+(LSN-YP)^2:RDIST=SQR((RSE-XP)^2+(RSN-YP)^2:LZ=TAN((90-LVA))*LDIST+LRL+LIH:RZ=TAN((90-RVA))*RDIST+RRL+RIH
280 MZ=(LZ+RZ)/2:ERZ=ABS(ABS(LZ)-ABS(RZ))
290 DEL=LSE-XP:DNL=LSN-YP:DER=RSE-XP:DNR=RSN-YP
300 Z=POL(DEL,DNL):LB=90-Y:IF LB<0 THEN LB=LB+360
310 Z=POL(DER,DNR):RB=90-Y:IF RB<0 THEN RB=RB+360
320 ANGINT=ABS(LB-RB):IF ANGINT>180 THEN ANGINT=360-ANGINT
340 CLS:BEEP 0:PRINT "x: ";ROUND(XP,-5);TAB(16);"y: ";ROUND(YP,-5);TAB(32);"z: ";ROUND(MZ,-5);TAB(47);"dz: ";ROUND(ERZ,-5):CLS
350 CLS:BEEP 0:PRINT "z";CHR$(145);": ";ROUND(LZ,-5);TAB(16);"z";CHR$(146);": ";ROUND(RZ,-5);TAB(32);"Angle of cut: ";DMS$(ANGINT):CLS
360 PRINT " [C] Continue [N] New Stations";
370 C$=INKEY$:IF C$="" THEN 370
380 IF C$="C" OR C$="c" THEN CLS:GOTO 220
390 IF C$="N" OR C$="n" THEN CLS:GOTO 20
400 GOTO 370
10 CLS:PRINT "Offset Program:":CLS:SET N
20 PRINT "Ax=";Ax;:INPUT Ax:PRINT "Ay=";Ay;:INPUT Ay:CLS
30 PRINT "Bx=";Bx;:INPUT Bx:PRINT "By=";By;:INPUT By:CLS
40 PRINT "Cx=";Cx;:INPUT Cx:PRINT "Cy=";Cy;:INPUT Cy:CLS:PRINT "Wait...";
50 Z=POL((Bx-Ax),(By-Ay)):BEARAB=90-Y:DISTAB=X
60 Z=POL((Cx-Ax),(Cy-Ay)):BEARAC=90-Y:DISTAC=X
70 DIFFBEAR=BEARAC-BEARAB
80 OFFSET=SIN(DIFFBEAR)*DISTAC:CHAIN=COS(DIFFBEAR)*DISTAC
90 IPE=SIN(BEARAB)*CHAIN+Ax:IPN=COS(BEARAB)*CHAIN+Ay
100 CLS:BEEP 0:PRINT "Offset:";ROUND(OFFSET,-5);TAB(16);"Chain:";ROUND(CHAIN,-5);TAB(32);"IPx:";ROUND(IPE,-5);TAB(48);"IPy:";ROUND(IPN,-5)
110 CLS:GOTO 40
10 CLS:PRINT "Open Traverse Program:"
15 CLS:SET N
20 PRINT "Start E:";SE;:INPUT SE:PRINT "Start N:";SN;:INPUT SN
25 CLS:PRINT " [B] Bearing to RO [C] Coords of RO";
30 I$=INKEY$
40 IF I$="C" OR I$="c" THEN 50
45 IF I$="B" OR I$="b" THEN 60 ELSE 30
50 CLS:PRINT "RO E:";ROE;:INPUT ROE:PRINT "RO N:";RON;:INPUT RON:CLS:GOTO 80
60 CLS:PRINT "RO Brg:";DMS$(ROBEAR);:INPUT ROBEAR
80 CLS:PRINT "Hz Ang:";DMS$(HZANG);:INPUT HZANG:PRINT "Hz Dist:";HZDIST;:INPUT HZDIST
90 CLS:PRINT "Wait...";
95 IF I$="B" OR I$="b" THEN 110
100 Z=POL((ROE-SE),(RON-SN)):ROBEAR=90-Y:IF ROBEAR<0 THEN ROBEAR=ROBEAR+360
110 FWDBRG=ROBEAR+HZANG
120 PTE=SIN(FWDBRG)*HZDIST+SE:PTN=COS(FWDBRG)*HZDIST+SN
130 CLS:BEEP 0:PRINT "x:";ROUND(PTE,-4);TAB(32);"y:"ROUND(PTN,-4):CLS
140 PRINT "Hz Ang:";DMS$(HZANG);:INPUT HZANG:PRINT "Hz Dist:";HZDIST;:INPUT HZDIST
150 CLS:PRINT "Wait...";
160 FWDBRG=FWDBRG+180+HZANG:IF FWDBRG>360 THEN FWDBRG=FWDBRG-360
170 SE=PTE:SN=PTN:GOTO 120
10 CLS:PRINT "Resection Program:":CLS:SET N
20 PRINT "Input the co-ords of three knownpoints in a CLOCKWISE direction":CLS
30 PRINT "x1:";x1;:INPUT x1:PRINT "y1:";y1;:INPUT y1:CLS
40 PRINT "x2:";x2;:INPUT x2:PRINT "y2:";y2;:INPUT y2:CLS
50 PRINT "x3:";x3;:INPUT x3:PRINT "y3:";y3;:INPUT y3:CLS
60 PRINT "Azimuth 1:";DMS$(AZ01);:INPUT AZ01:CLS
70 PRINT "Azimuth 2:";DMS$(AZ02);:INPUT AZ02:CLS
80 PRINT "Azimuth 3:";DMS$(AZ03);:INPUT AZ03:CLS:PRINT "Wait...";
90 Z=POL((x2-x1),(y2-y1)):AZ12=90-Y:Z=POL((x3-x2),(y3-y2)):AZ23=90-Y:Z=POL((x1-x3),(y1-y3)):AZ31=90-Y
100 A=AZ31+180-AZ12:B=AZ12+180-AZ23:C=AZ23+180-AZ31
110 c=AZ02-AZ01+360:b=AZ01-AZ03+360:a=AZ03-AZ02+360
120 K1=1/((1/TAN(A))-(1/TAN(a)))
130 K2=1/((1/TAN(B))-(1/TAN(b)))
140 K3=1/((1/TAN(C))-(1/TAN(c)))
150 EP=((K1*x1)+(K2*x2)+(K3*x3))/(K1+K2+K3)
160 NP=((K1*y1)+(K2*y2)+(K3*y3))/(K1+K2+K3)
170 Z=POL((x1-EP),(y1-NP):brg1=90-Y:IF brg1<0 THEN brg1=brg1+360
180 Z=POL((x2-EP),(y2-NP):brg2=90-Y:IF brg2<0 THEN brg2=brg2+360
190 Z=POL((x3-EP),(y3-NP):brg3=90-Y:IF brg3<0 THEN brg3=brg3+360
200 CLS:BEEP 0:PRINT "E: ";ROUND(EP,-5);TAB(32);"N: ";ROUND(NP,-5):CLS
210 BEEP 0:PRINT "Set Bearings";TAB(16);"1:";DMS$(brg1);TAB(32);"2:";DMS$(brg2);TAB(48);"3:";DMS$(brg3)
220 CLS:GOTO 20
PROGRAMA EN BASIC:
10 CLEAR:CLS
20 INPUT "Numero de incognitas";I
30 DIM X(I,(I+1)):DIM Y(I+1)
40 FOR J=1 TO I
50 FOR K=1 TO I+1
60 PRINT "X(";J;",";K;")";:INPUT X(J,K)
70 NEXT K
75 CLS
80 NEXT J
90 CLS:PRINT "Su operacion se esta calculando,espere un momento, por favor";
100 FOR L=1 TO I-1
105 IF X(L,L)=0 THEN GOSUB 1000
109 FOR J=L+1 TO I
110 IF X(J,L)=0 THEN IF L=I-1 THEN 400 ELSE 150
115 A=X(J,L)
120 FOR K=L TO I+1
130 X(J,K)=X(J,K)*X(L,L)-X(L,K)*A
140 NEXT K
150 NEXT J
160 NEXT L
400 FOR K=1 TO I
410 Y(K)=1
420 NEXT K
500 FOR J=1 TO 1 STEP-1
505 A=0
510 FOR K=1 TO I
520 A=X(J,K)*Y(K)+A
530 NEXT K
535 IF X(J,J)=0 THEN CLS:PRINT"El sistema no es compatible determinado":END
540 Y(J)=(X(J,I+1)+X(J,J)-A)/X(J,J)
550 NEXT J
560 CLS
570 FOR K=1 TO I
580 PRINT "X(";K;")=";Y(K);
585 IF INKEY$="" THEN 585
590 NEXT K
600 END
1000 REM BUSCAR PIVOTE DISTINTO DE 0
1015 A=1
1020 FOR K=1 TO I+1
1025 Y(K)=X(L,K)
1030 NEXT K
1040 FOR K=1 TO I+1
1047 ON ERROR GOTO 5000
1050 X(L,K)=X(L+A,K)
1060 NEXT K
1070 FOR K=1 TO I+1
1080 X(L+A,K)=Y(K)
1092 NEXT K
1095 IF X(L,L)<>0 THEN RETURN ELSE A=A+1:GOTO 1020
5000 PRINT "Alguna de estas ecuaciones son combinacion lineal de las otras":END
5 CLS : CLEAR
10 PRINT "RESOLUCION DE ECUACIONES DE SEGUNDO GRADO"
20 PRINT "ax^2+bx+C=0"
30 INPUT "a="; A
40 INPUT "b="; B
50 INPUT "c="; C
60 D = B * B - (4 * A * C)
70 SX = -B / (2 * A)
80 IF D >= 0 THEN GOTO 100
90 IF D < 0 THEN GOTO 130
100 FY = (SQR(D)) / (2 * A)
110 PRINT "S1="; SX + FY
120 PRINT "S2="; SX - FY
125 END
130 FZ = (SQR(-D)) / (2 * A)
140 PRINT "S1="; SX; "+"; FZ; "i"
150 PRINT "S2="; SX; "-"; FZ; "i"
160 END
No hay comentarios:
Publicar un comentario