Surveying program for the HP-71B



#2

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.


#3

gerson- fortunately; english and portugese both got their words for mathematical concepts from latin, so they abbreviate about the same. thanks for the post.


#4

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

Possibly Related Threads...
Thread Author Replies Views Last Post
  HP Prime: run a program in another program Davi Ribeiro de Oliveira 6 864 11-11-2013, 08:28 PM
Last Post: Davi Ribeiro de Oliveira
  Land surveying programs have nowhere to go JJB299 11 1,117 06-13-2013, 09:14 PM
Last Post: Egan Ford
  TDS-GX/ Surveying aj04062 1 375 08-22-2011, 10:51 PM
Last Post: Martin Pinckney
  HP-IL 71B to 71B via HPIL Geoff Quickfall 11 1,217 12-01-2010, 06:55 PM
Last Post: Michael Meyer
  Surveying Pacs for HP-48 Jeff Kearns 2 460 05-08-2010, 02:00 PM
Last Post: db (martinez, ca.)
  HP-41 MCODE: Making an MCODE program call another MCODE program Geir Isene 10 1,101 01-13-2008, 05:58 AM
Last Post: Raymond Del Tondo
  Precision Surveying Solutions L L C Forrest Switzer 5 630 04-28-2007, 10:52 AM
Last Post: Tim Wessman
  hp50g surveying solutions tom grimes 4 479 03-17-2007, 12:11 PM
Last Post: buygm
  HP41CV/Kern Surveying Instruments William Lafferty 0 247 03-23-2006, 04:45 PM
Last Post: William Lafferty
  New HP-71B Program - YATZ71 Howard Owen 5 635 10-18-2005, 06:08 PM
Last Post: Howard Owen

Forum Jump: