The Museum of HP Calculators

HP Forum Archive 17

 Surveying program for the HP-71B Message #1 Posted by Gerson W. Barbosa on 27 Aug 2007, 10:32 p.m. The following program computes the area of an n-side irregular polygon, given the side-lengths and the internal angles. The coordinates are also calculated. An automatic misclose adjustment is provided. Actually, I know nothing of surveying. I just turned a surveying sheet into a CASIO PB-700 BASIC program, from which this version came from. Messages are in the original Portuguese but the examples might be easy to follow. Just for an idea, for an equal-sided triangle enter 3, 10, 60, 10, 60, 10, 60, 90 as requested (side = 10 lenght units). The result should be 43.301 area units and the coordinates for plotting it on a Cartesian plane would be (0.000, 0.000), (10.000, 0.000) and (5.000, 8.666). ```10 DESTROY ALL @ INPUT "No. de Estacoes? ";N @ IF N>370 THEN 10 ELSE IF N>2 THEN 20 ELSE 10 20 DEGREES @ DELAY 0,0 @ OPTION BASE 1 @ K=180*(N-2) @ DIM A(N),D(N),X(N),Y(N),Z(N) 30 FOR I=1 TO N @ DISP "DIST(";STR\$(I); @ INPUT "): ";D(I) @ L=L+D(I) @ DISP "ANGL(";STR\$(I); 40 INPUT "): ";B @ GOSUB 310 @ A(I)=B @ W=W+1/D(I) @ G=G+A(I) @ NEXT I 70 E=ABS(G-K)*60/N @ IF E>2 THEN GOSUB 330 @ DISP "Ang.:";INT(E);"'/vt" @ WAIT 1 @ GOTO 335 80 INPUT "Azimute: ";B @ GOSUB 310 @ Z(1)=B 90 GOSUB 350 @ H=G-K @ T=H/W @ FOR I=2 TO N @ A(I)=A(I)-T/D(I) @ Z(I)=Z(I-1)+A(I) 100 IF Z(I)>180 THEN Z(I)=Z(I)-180 ELSE Z(I)=Z(I)+180 120 NEXT I @ U=0 @ V=0 @ FOR I=1 TO N @ X(I)=D(I)*SIN(Z(I)) @ Y(I)=D(I)*COS(Z(I)) 130 U=U+X(I) @ V=V+Y(I) @ NEXT I @ F=SQR(U^2+V^2)/L*1000 140 IF F>2 THEN GOSUB 330 @ DISP "Lin.:";INT(F);"m/km" @ WAIT 1 @ GOTO 345 150 GOSUB 350 @ A(1)=A(1)-T/D(1) @ P=U/L @ Q=V/L @ FOR I=1 TO N @ T=X(I)-D(I)*P @ X(I)=T+2*C 160 C=C+T @ Y(I)=Y(I)-D(I)*Q @ R=R+X(I)*Y(I) @ D(I)=T @ NEXT I @ BEEP 170 DELAY 9,0 @ DISP "Area:"; @ DISP USING 430;R/2 180 DISP "Erro Lin.: "; @ DISP USING 440;F 190 DISP "Erro Ang.: "; @ DISP USING 450;E @ U=0 @ V=0 200 FOR I=1 TO N @ Z(I)=FP(Z(I))+MOD(INT(Z(I)),360) @ IF Z(I)<90 THEN X\$="NE" @ GOTO 260 210 IF Z(I)<180 THEN Z(I)=180-Z(I) @ X\$="SE" @ GOTO 260 220 IF Z(I)<270 THEN Z(I)=Z(I)-180 @ X\$="SO" @ GOTO 260 230 Z(I)=360-Z(I) @ X\$="NO" 260 B=Z(I) @ GOSUB 320 270 DISP "X(";STR\$(I);")"; @ DISP TAB(9); @ DISP USING 460;U @ DISP "Y(";STR\$(I);")"; 275 DISP TAB(9); @ DISP USING 460;V @ D\$=STR\$(INT(Z(I))) 280 M\$=CHR\$(48*(2-LEN(STR\$(M))))&STR\$(M) @ S\$=CHR\$(48*(2-LEN(STR\$(S))))&STR\$(S) 285 DISP "R(";STR\$(I);")";TAB(10-LEN(D\$));D\$;CHR\$(167);" ";M\$;"' ";S\$;CHR\$(34);" ";X\$ 290 U=U+D(I) @ V=V+Y(I) @ NEXT I @ END 300 X\$=UPRC\$(KEY\$) @ IF X\$="" OR X\$#"S" AND X\$#"N" THEN 300 ELSE RETURN 310 M=INT(100*FP(B)) @ S=100*FP(100*FP(B)) @ B=INT(B)+M/60+S/3600 @ RETURN 320 T=FP(B)+.000000005 @ M=INT(60*T) @ S=INT(MOD(3600*T,60)) @ RETURN 330 BEEP @ PRINT "Erro "; @ RETURN 335 GOSUB 340 @ IF X\$="S" THEN 360 ELSE 80 340 DISP "Reentrar? " @ GOSUB 300 @ RETURN 345 GOSUB 340 @ IF X\$="S" THEN 400 ELSE GOTO 150 350 DISP "Aguarde..." @ RETURN 360 G=0 @ FOR I=1 TO N @ B=A(I) @ GOSUB 320 @ B=(S+100*M)*.0001+INT(B) 365 A(I)=B @ DISP "ANGL(";STR\$(I);"): "; 380 INPUT "",STR\$(A(I));X1\$ @ IF X1\$="" THEN B=A(I) ELSE B=VAL(X1\$) 390 GOSUB 310 @ A(I)=B @ G=G+A(I) @ NEXT I @ GOTO 70 400 L=0 @ W=0 @ FOR I=1 TO N @ IF I>1 THEN A(I)=A(I)+T/D(I) 410 DISP "DIST(";STR\$(I);"): "; @ INPUT "",STR\$(D(I));X1\$ @ IF X1\$<>"" THEN D(I)=VAL(X1\$) 420 L=L+D(I) @ W=W+1/D(I) @ NEXT I @ GOTO 90 430 IMAGE 9D.DDD," m2" 440 IMAGE Z.DD," m/km" 450 IMAGE Z.DD," '/vt" 460 IMAGE 5D.DDD ======================================================================== >RUN No. de Estacoes? 7 DIST(1): 439.20 ANGL(1): 59.1930 DIST(2): 219.80 ANGL(2): 211.4900 DIST(3): 351.10 ANGL(3): 74.4245 DIST(4): 192.75 ANGL(4): 198.1115 DIST(5): 303.80 ANGL(5): 60.5000 DIST(6): 305.90 ANGL(6): 169.4930 DIST(7): 446.80 ANGL(7): 125.1915 Azimute: 81 Aguarde... Aguarde... Area: 256500.544 m2 Erro Lin.: 0.28 m/km Erro Ang.: 0.18 '/vt X(1) 0.000 Y(1) 0.000 R(1) 81º 00' 00" NE X(2) 433.711 Y(2) 68.797 R(2) 67º 11' 14" SE X(3) 636.277 Y(3) -16.378 R(3) 7º 31' 21" NE X(4) 682.178 Y(4) 331.773 R(4) 25º 42' 20" NE X(5) 765.747 Y(5) 505.487 R(5) 86º 32' 09" SO X(6) 462.446 Y(6) 487.194 R(6) 76º 21' 29" SO X(7) 165.119 Y(7) 415.110 R(7) 21º 40' 37" SO ======================================================================== >RUN No. de Estacoes? 9 DIST(1): 5.1 ANGL(1): 213 DIST(2): 5.0 ANGL(2): 138 DIST(3): 9.5 ANGL(3): 342.20 DIST(4): 11.4 ANGL(4): 34 DIST(5): 10 ANGL(5): 91 DIST(6): 7.3 ANGL(6): 53 DIST(7): 6.2 ANGL(7): 266 DIST(8): 9 ANGL(8): 77.3 DIST(9): 4.2 ANGL(9): 45 Azimute: 0 Aguarde... Erro Lin.: 43 m/km Reentrar? DIST( 1 ): 5.1 DIST( 2 ): 5 DIST( 3 ): 9.5 DIST( 4 ): 11.4 DIST( 5 ): 10 DIST( 6 ): 7.3 DIST( 7 ): 9.2 DIST( 8 ): 9 DIST( 9 ): 4.2 Aguarde... Aguarde... Area: 101.203 m2 Erro Lin.: 1.01 m/km Erro Ang.: 1.11 '/vt X(1) 0.000 Y(1) 0.000 R(1) 0º 00' 00" NE X(2) .003 Y(2) 5.104 R(2) 41º 58' 27" NO X(3) -3.339 Y(3) 8.826 R(3) 59º 37' 37" SE X(4) 4.862 Y(4) 4.031 R(4) 25º 36' 56" NO X(5) -.060 Y(5) 14.320 R(5) 65º 23' 50" SO X(6) -9.147 Y(6) 10.166 R(6) 61º 35' 06" SE X(7) -2.723 Y(7) 6.698 R(7) 24º 25' 45" SO X(8) -6.523 Y(8) -1.670 R(8) 78º 03' 23" SE X(9) 2.287 Y(9) -3.525 R(9) 33º 01' 32" NO ======================================================================== >RUN No. de Estacoes? 21 DIST(1): 296.78 ANGL(1): 199.44 DIST(2): 384.09 ANGL(2): 133.3143 DIST(3): 215.99 ANGL(3): 49.5308 DIST(4): 58.43 ANGL(4): 186.1700 DIST(5): 268.00 ANGL(5): 248.3000 DIST(6): 180.53 ANGL(6): 144.4304 DIST(7): 34.03 ANGL(7): 182.2620 DIST(8): 114.03 ANGL(8): 135.5100 DIST(9): 68.75 ANGL(9): 183.1600 DIST(10): 28.13 ANGL(10): 161.5518 DIST(11): 63.62 ANGL(11): 196.0440 DIST(12): 313.65 ANGL(12): 177.1000 DIST(13): 530.60 ANGL(13): 190.0730 DIST(14): 691.69 ANGL(14): 180.0727 DIST(15): 1043.90 ANGL(15): 68.3100 DIST(16): 183.37 ANGL(16): 129.4007 DIST(17): 134.44 ANGL(17): 180.1500 DIST(18): 59.05 ANGL(18): 177.5940 DIST(19): 360.99 ANGL(19): 142.5300 DIST(20): 522.42 ANGL(20): 179.4830 DIST(21): 322.80 ANGL(21): 171.1340 Azimute: 40.2500 Aguarde... Aguarde... Area: 1729019.963 m2 Erro Lin.: 0.22 m/km Erro Ang.: 0.09 '/vt X(1) 0.000 Y(1) 0.000 R(1) 40º 25' 00" NE X(2) 192.378 Y(2) 226.009 R(2) 6º 03' 15" NO X(3) 151.820 Y(3) 608.028 R(3) 43º 49' 55" SO X(4) 2.210 Y(4) 452.259 R(4) 50º 07' 06" SO X(5) -42.635 Y(5) 414.804 R(5) 61º 22' 52" NO X(6) -277.925 Y(6) 543.221 R(6) 83º 20' 15" SO X(7) -457.259 Y(7) 522.310 R(7) 85º 46' 53" SO X(8) -491.201 Y(8) 519.813 R(8) 41º 37' 59" SO X(9) -566.972 Y(9) 434.606 R(9) 44º 54' 07" SO X(10) -615.511 Y(10) 385.923 R(10) 26º 49' 47" SO X(11) -628.210 Y(11) 360.826 R(11) 42º 54' 37" SO X(12) -671.534 Y(12) 314.241 R(12) 40º 04' 39" SO X(13) -873.508 Y(13) 74.302 R(13) 50º 12' 10" SO X(14) -1281.241 Y(14) -265.222 R(14) 50º 19' 38" SO X(15) -1813.722 Y(15) -706.671 R(15) 61º 09' 22" SE X(16) -899.461 Y(16) -1210.080 R(16) 68º 30' 48" NE X(17) -728.857 Y(17) -1142.881 R(17) 68º 45' 53" NE X(18) -603.562 Y(18) -1094.162 R(18) 66º 45' 43" NE X(19) -549.310 Y(19) -1070.852 R(19) 29º 38' 45" NE X(20) -370.796 Y(20) -757.049 R(20) 29º 27' 16" NE X(21) -113.971 Y(21) -302.056 R(21) 20º 40' 58" NE ======================================================================== ``` Edited: 27 Aug 2007, 10:46 p.m.

 Re: Surveying program for the HP-71B Message #2 Posted by db(martinez,ca) on 28 Aug 2007, 5:02 p.m.,in response to message #1 by Gerson W. Barbosa gerson- fortunately; english and portugese both got their words for mathematical concepts from latin, so they abbreviate about the same. thanks for the post.

 Re: Surveying program for the HP-71B Message #3 Posted by Gerson W. Barbosa on 28 Aug 2007, 8:46 p.m.,in response to message #2 by db(martinez,ca) The QBASIC version gives the same results, except for occasional differences of one second. I'd like to check them upon an authoritative software, but I don't have any. Gerson. ```3 DEFDBL A-H, J-Z: DEFINT I 5 DEF FNFRAC (NN) = NN + 1E-12 - INT(NN + 1E-12) 10 CLS : CLEAR : INPUT "No. de Estacoes? ", N: IF N > 999 THEN 10 ELSE IF N > 2 THEN 20 ELSE 10 20 GR = ATN(1) / 45: K = 180 * (N - 2): N = N - 1: DIM A(N), D(N), X(N), Y(N), Z(N): FOR I = 0 TO N: CLS 30 PRINT "DIST("; : PRINT USING "###"; I + 1; : PRINT "):"; : LOCATE 3, 1: PRINT "ANGL("; : PRINT USING "###"; I + 1; : PRINT "):"; : LOCATE 1, 12 40 INPUT "", D(I): SL = SL + D(I): LOCATE 3, 12: INPUT "", AN: GOSUB 310: A(I) = AN 50 SI = SI + 1 / D(I): SA = SA + A(I): NEXT I 60 CLS : EA = ABS(SA - K) * 60 / (N + 1) 70 IF EA > 2 THEN GOSUB 330: PRINT "Ang.:"; INT(EA); CHR\$(39); "/vt": GOSUB 340: IF X\$ = "S" OR X\$ = "s" THEN 360 80 CLS : INPUT "Azimute: ", AN: GOSUB 310: Z(0) = AN 90 GOSUB 350: DA = SA - K: T = DA / SI: FOR I = 1 TO N: A(I) = A(I) - T / D(I) 100 Z(I) = Z(I - 1) + A(I): IF Z(I) > 180 THEN Z(I) = Z(I) - 180 ELSE Z(I) = Z(I) + 180 110 NEXT I: SX = 0: SY = 0 120 FOR I = O TO N: X(I) = D(I) * SIN(GR * Z(I)): Y(I) = D(I) * COS(GR * Z(I)): SX = SX + X(I): SY = SY + Y(I): NEXT I 130 EL = SQR(SX ^ 2 + SY ^ 2) / SL * 1000! 140 IF EL > 2 THEN CLS : GOSUB 330: PRINT "Lin.:"; INT(EL); "m/km": GOSUB 340: IF X\$ = "S" OR X\$ = "s" THEN 400 150 GOSUB 350: A(0) = A(0) - T / D(0): KX = SX / SL: KY = SY / SL: FOR I = 0 TO N: T = X(I) - D(I) * KX: X(I) = T + 2 * SC 160 SC = SC + T: Y(I) = Y(I) - D(I) * KY: AR = AR + X(I) * Y(I): D(I) = T: NEXT I: CLS : BEEP 170 PRINT "AREA:"; USING "########.####"; AR / 2; : PRINT "m2": PRINT 180 PRINT "Erro Lin.:"; USING "###.##"; EL; : PRINT "m/km" 190 PRINT "Erro Ang.:"; USING "###.##"; EA; : PRINT CHR\$(39); "/vt"; : GOSUB 300: SX = 0: SY = 0 200 FOR I = 0 TO N: CLS : Z(I) = FNFRAC(Z(I)) + INT(Z(I)) MOD 360: IF Z(I) < 90 THEN X\$ = "NE": GOTO 260 210 IF Z(I) < 180 THEN Z(I) = 180 - Z(I): X\$ = "SE ": GOTO 260 220 IF Z(I) < 270 THEN Z(I) = Z(I) - 180: X\$ = "SO ": GOTO 260 230 Z(I) = 360 - Z(I): X\$ = "NO" 260 AN = Z(I): GOSUB 320 270 PRINT "X("; : PRINT USING "###"; I + 1; : PRINT "):"; USING "#######.###"; SX: PRINT "Y("; : PRINT USING "###"; I + 1; : PRINT "):"; USING "#######.###"; SY 280 PRINT : PRINT "R("; : PRINT USING "###"; I + 1; : PRINT "): "; : PRINT USING "###"; INT(AN); : PRINT "°"; : PRINT USING "##"; M; : PRINT "'"; : PRINT USING "##"; S; : PRINT CHR\$(34); " "; X\$; 290 SX = SX + D(I): SY = SY + Y(I): GOSUB 300: NEXT I: CLS : END 300 X\$ = INKEY\$: IF X\$ = "" THEN 300 ELSE RETURN 310 M = INT(100 * FNFRAC(AN)): S = 100 * FNFRAC(100 * FNFRAC(AN)): AN = INT(AN) + M / 60 + S / 3600: RETURN 320 T = FNFRAC(AN): M = INT(60 * T): S = FNFRAC(((3600 * T) / 60)) * 60 323 IF INT(S + .5) = 60 THEN S = 0: M = M + 1 325 IF M = 60 THEN M = 0: AN = AN + 1 328 RETURN 330 BEEP: PRINT "Erro "; : RETURN 340 LOCATE 3, 1: PRINT "Reentrar? ": GOSUB 300: RETURN 350 CLS : PRINT "Aguarde...; ": RETURN 360 SA = 0: FOR I = 0 TO N: CLS : AN = A(I): GOSUB 320: AN = (S + 100 * M) * .0001 + INT(AN): A(I) = AN: PRINT "ANGL("; 370 PRINT USING "###"; I + 1; : PRINT "): "; USING "###.####"; A(I); : LOCATE 1, 14 + LEN(STR\$(I)) - LEN(STR\$(INT(A(I)))) 380 INPUT "", X1\$: IF X1\$ = "" THEN AN = A(I) ELSE AN = VAL(X1\$) 390 GOSUB 310: A(I) = AN: SA = SA + A(I): NEXT I: GOTO 60 400 SL = 0: SI = 0: FOR I = 0 TO N: IF I > 0 THEN A(I) = A(I) + T / D(I) 410 CLS : PRINT "DIST("; : PRINT USING "###"; I + 1; : PRINT "):"; : PRINT USING "####.###"; D(I) 420 LOCATE 1, 14 + LEN(STR\$(I)) - LEN(STR\$(INT(D(I)))) 430 INPUT "", X1\$: IF X1\$ <> "" THEN D(I) = VAL(X1\$) 440 SL = SL + D(I): SI = SI + 1 / D(I): NEXT I: GOTO 90 ```

Go back to the main exhibit hall