The Museum of HP Calculators

HP Forum Archive 17

[ Return to Index | Top of Index ]

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? <S,N>" @ 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? <S,N> 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? <S,N>": 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


[ Return to Index | Top of Index ]

Go back to the main exhibit hall