Category : Printer + Display Graphics
Archive   : 1988LISP.ZIP
Filename : SURVEY.BAS
20 ' * *
30 ' * SURVEY DRAFTER *
40 ' * *
50 ' * Developed and written by Terry Majewski *
60 ' * *
70 ' * Convert user input survey data to ACAD script file *
80 ' * *
90 ' * *
100 ' **********************************************************************
110 WIDTH 80
120 CLS:KEY OFF
130 LOCATE 8,1:PRINT STRING$(80,177)
140 LOCATE 9,31:PRINT"SURVEY DRAFTER tm"
150 LOCATE 10,1:PRINT STRING$(80,177)
160 LOCATE 12,33:PRINT"version 2.00"
170 LOCATE 14,26:PRINT "Copywrite 1987 T. Majewski"
180 FOR DELAY = 1 TO 3500:NEXT
190 CLS
200 LOCATE 6,20:PRINT"<<<=== SURVEY PLOTTER MENU ===>>>"
210 LOCATE 7,20:PRINT STRING$(33,205)
220 LOCATE 8,20:PRINT"1) ENTER survey to EXISTING file "
230 LOCATE 9,20:PRINT"2) REVIEW an EXISTING data file "
240 LOCATE 10,20:PRINT"3) EDIT an EXISTING data file "
250 LOCATE 11,20:PRINT"4) CONVERT survey data to ACAD "
260 LOCATE 12,20:PRINT"5) START a new data file "
270 LOCATE 13,20:PRINT"6) EXIT the program "
280 LOCATE 14,20:PRINT STRING$(33,205)
290 LOCATE 16,20:INPUT"YOUR CHOICE ---->> ",CHOICE
300 IF CHOICE=>7 THEN SOUND 200,2:GOTO 290
310 ON CHOICE GOTO 320,720,720,1700,1460,710
320 ' ENTER NEW DATA ************************************************
330 CLS:LOCATE 12,20:PRINT"NAME OF FILE FOR SURVEY DATA ---->> ";FL$
340 LOCATE 12,56:INPUT "",F$
350 IF F$="" THEN 370
360 FL$=F$:FILE$=F$+".SDT"
370 GOSUB 1350 ' OPEN DATA FILE FOR INPUT--------------------------------
380 GOSUB 1390 ' GET BLANK ENTRY #---------------------------------------
390 IF PT>750 THEN 400 ELSE 440
400 LOCATE 14,20:PRINT"SURVEY DATA FILE NOT STARTED........."
410 LOCATE 15,20:PRINT"SELECT OPTION 5 IN THE MENU TO START A NEW DATA FILE!
420 LOCATE 17,20:PRINT "Press any key to continue!";
430 WHILE INKEY$="":WEND:CLOSE:GOTO 190
440 CLS
450 IF CHOICE=3 THEN 460 ELSE 470
460 LOCATE 12,42:PRINT CVS(PTD$)
470 LOCATE 12,60:PRINT "0 = Quit"
480 LOCATE 12,20:PRINT"DISTANCE PT#";:PRINT USING"###";PT;:INPUT" ---->> ",D$
490 IF D$="" THEN D$=STR$(CVS(PTD$))
500 IF D$="0" THEN 700
510 D=VAL(D$):LOCATE 12,60:PRINT" "
520 IF CHOICE = 3 THEN 530 ELSE 540
530 LOCATE 14,43:PRINT PTA$
540 LOCATE 14,20:PRINT"ANGLE TO PT#";:PRINT USING"###";PT;:INPUT" ---->> ",AG$
550 IF AG$="" THEN AG$=PTA$
560 IF CHOICE = 3 THEN 570 ELSE 580
570 LOCATE 16,43:PRINT ELEV$
580 LOCATE 16,20:PRINT"ELEV FOR PT#";:PRINT USING"###";PT;:INPUT" ---->> ",EL$
590 IF EL$="" AND CHOICE=3 THEN EL$=ELEV$
600 IF CHOICE = 3 THEN 610 ELSE 620
610 LOCATE 18,43:PRINT TEXT$
620 LOCATE 18,20:PRINT"NOTE FOR PT#";:PRINT USING"###";PT;:INPUT" ---->> ",TXT$
630 IF TXT$="" AND CHOICE = 3 THEN TXT$=TEXT$
640 LOCATE 20,20:INPUT"SURVEY DATA CORRECT
650 IF Y$="N" OR Y$="n" THEN 690
660 GOSUB 1620 ' WRITE SURVEY DATA TO DISK -------------------------------
670 IF CHOICE=3 THEN 830
680 GOTO 380
690 CLS:GOTO 450
700 CLOSE #1:GOTO 190
710 CLS:SYSTEM
720 ' REVIEW SURVEY DATA POINTS ------------------------------------------
730 CLS:LOCATE 12,20:PRINT"NAME OF SURVEY DATA FILE ---->> ";FL$
740 LOCATE 12,52:INPUT "",F$
750 IF F$="" THEN 770
760 FL$=F$:FILE$=F$+".SDT"
770 LOCATE 14,20:PRINT"BEGIN REVIEW WITH WHAT POINT # --->>1"
780 LOCATE 14,56:INPUT "",J$
790 IF J$="" THEN J$="1"
800 J=VAL(J$)
810 REVIEWCK=0
820 GOSUB 1350 ' OPEN SURVEY DATA FILE FOR REVIEW ------------------------
830 CLS
840 LOCATE 1,1:PRINT"SURVEY DATA POINTS"
850 LOCATE 2,1:PRINT STRING$(80,205)
860 LOCATE 3,1:PRINT "POINT #":LOCATE 3,15:PRINT"DISTANCE":LOCATE 3,30:PRINT"ANGLE":LOCATE 3,45:PRINT"ELEV":LOCATE 3,54:PRINT "NOTE"
870 LOCATE 4,1:PRINT STRING$(80,205)
880 IF REVIEWCK=1 THEN 900
890 LNE=5
900 FOR I = J TO 750
910 GET #1,I
920 IF A$="D" THEN 1050
930 IF A$="E" THEN 1060
940 LOCATE LNE,1:PRINT I:LOCATE LNE,15:PRINT CVS(PTD$):LOCATE LNE,30:PRINT PTA$:LOCATE LNE,45:PRINT ELEV$:LOCATE LNE,54:PRINT TEXT$
950 LNE=LNE+1
960 IF LNE=22 THEN 970 ELSE 1050
970 IF CHOICE =3 THEN 1110
980 LOCATE 22,1:PRINT STRING$(80,205)
990 LOCATE 23,1:PRINT"
1000 K$=INKEY$
1010 IF K$="" THEN 1000
1020 IF K$="Q" THEN 1100
1030 J=I:LNE=5:REVIEWCK=1
1040 GOTO 830
1050 NEXT I
1060 IF CHOICE =3 THEN 1110
1070 LOCATE 22,1:PRINT STRING$(80,205)
1080 LOCATE 23,1:PRINT"END OF SURVEY DATA ...........Press any key to continue!"
1090 WHILE INKEY$="":WEND
1100 CLOSE #1:GOTO 190
1110 LOCATE 22,1:PRINT STRING$(80,205)
1120 IF A$="E" THEN 1130 ELSE 1140
1130 LOCATE 23,50:PRINT"Q = QUIT":GOTO 1150
1140 LOCATE 23,50:PRINT"Q = QUIT M = More":REVEIWCK=1
1150 LOCATE 23,1:INPUT"SURVEY POINT TO EDIT --->>",EPT$
1160 EPT=VAL(EPT$)
1170 IF EPT$="M" THEN 1030
1180 IF EPT$= "Q" THEN 1340
1190 LOCATE 23,50:PRINT" ";
1200 SOUND 200,2:LOCATE 23,50:PRINT"DELETE #";EPT;:INPUT DEL$
1210 IF DEL$="N" OR DEL$="n" OR DEL$="" THEN 1300
1220 LOCATE 23,50:PRINT" ";
1230 SOUND 200,2:LOCATE 23,50:PRINT"DELETE #";EPT;:INPUT"YOUR SURE";SURE$
1240 IF SURE$="Y" OR SURE$="y" THEN 1260 ELSE 1250
1250 LOCATE 23,50:PRINT" ";:GOTO 1140
1260 LOCATE 23,50:PRINT" ";
1270 SOUND 200,2:LOCATE 23,50:PRINT"POINT #";EPT;" DELETED!";:FOR DELAY = 1 TO 1200:NEXT
1280 LSET A$="D":PUT #1,EPT
1290 LOCATE 23,50:PRINT" ";:GOTO 1140
1300 LET PT=EPT
1310 CLS:LNE=5
1320 GET #1,EPT
1330 GOTO 450
1340 CLOSE #1:GOTO 190
1350 ' OPEN RANDOM ACCESS FILE FOR INPUT--------------------------------------
1360 OPEN "R",#1,FILE$,43
1370 FIELD #1,1 AS A$,8 AS PTD$,10 AS PTA$,8 AS ELEV$,16 AS TEXT$
1380 RETURN
1390 ' GET BLANK ENTRY ------------------------------------------------------
1400 FOR I=1 TO 750
1410 GET #1,I
1420 IF A$="E" OR A$="D" THEN 1440 ELSE 1430
1430 NEXT I
1440 LET PT=I
1450 RETURN
1460 ' INITIALIZE SURVEY DATA FILE --------------------------------------
1470 DELCK=0
1480 CLS:LOCATE 12,20:INPUT"INITIALIZE NEW SURVEY DATA FILE (Y/N)";Y$
1490 IF Y$="Y" OR Y$="y" THEN 1500 ELSE 190
1500 LOCATE 14,20:INPUT"NAME OF DATA FILE TO START ---->>",FILE$
1510 LOCATE 16,20:PRINT "PREPARING FILE FOR ENTRY NO:"
1520 FL$=FILE$
1530 FILE$=FILE$+".SDT"
1540 GOSUB 1350
1550 FOR I = 1 TO 750
1560 LSET A$="E"
1570 PUT #1,I
1580 LOCATE 16,48:PRINT USING "###";I;
1590 NEXT I
1600 CLOSE #1
1610 GOTO 190
1620 ' WRITE SURVEY DATA TO DISK -------------------------------------------
1630 LSET A$="F"
1640 LSET PTD$=MKS$(D):LSET PTA$=AG$:LSET ELEV$=EL$:LSET TEXT$=TXT$
1650 IF CHOICE=3 THEN 1660 ELSE 1680
1660 PUT #1,EPT
1670 CLS:GOTO 830
1680 PUT #1,PT
1690 RETURN
1700 ' CONVERT SURVEY DATA FILE TO ACAD SCRIPT FILE FOR PLOTTING--------
1710 CLS
1720 LOCATE 10,20:PRINT"CONVERT SURVEY DATA TO ACAD SCRIPT FILE"
1730 LOCATE 11,20:PRINT STRING$(40,205)
1740 LOCATE 12,20:PRINT"NAME OF SURVEY SOURCE FILE ----------->>";FL$
1750 LOCATE 12,60:INPUT "",F$
1760 IF F$="" THEN 1780
1770 FL$=F$:FILE$=F$+".SDT"
1780 LOCATE 14,20:PRINT"NAME OF ACAD SCRIPT FILE FOR DATA ---->>";FL$
1790 LOCATE 14,60:INPUT "",F2$
1800 IF F2$="" THEN 1820
1810 AFILE$=F2$:GOTO 1830
1820 AFILE$=FL$:XP$="1800":YP$="1200":TH$="2":Y$="Y"
1830 LOCATE 16,20:PRINT"ACAD X ORIGIN FOR TRANSIT POINT ---->>";XP$
1840 LOCATE 16,60:INPUT "",XO$
1850 IF XO$="" THEN XORD=VAL(XP$) ELSE XORD=VAL(XO$)
1860 LOCATE 18,20:PRINT"ACAD Y ORIGIN FOR TRANSIT POINT ---->>";YP$
1870 LOCATE 18,60:INPUT "",YO$
1880 IF YO$="" THEN YORD=VAL(YP$) ELSE YORD=VAL(YP$)
1890 LOCATE 20,20:PRINT"ACAD TEXT HEIGHT --------------------->>";TH$
1900 LOCATE 20,60:INPUT "",HT$
1910 IF HT$="" THEN 1920 ELSE 1930
1920 HT$=TH$
1930 LOCATE 22,20:PRINT"CONVERSION DATA CORRECT Y/N --------->>";Y$
1940 LOCATE 22,60:INPUT "",Y$
1950 IF Y$="N" OR Y$="n" THEN 1710
1960 CLS:LOCATE 12,25:PRINT"CALCULATING SURVEY POINT:"
1970 AFILE$=AFILE$+".SCR":OFILE$=FL$+".XYZ"
1980 ORIGIN$=XP$+","+YP$
1990 GOSUB 1350
2000 OPEN AFILE$ FOR OUTPUT AS #2
2010 OPEN OFILE$ FOR OUTPUT AS #3
2020 P$="POINT":T$="TEXT"+" @" +HT$+"<0 "+HT$+" 0":LA$="LAYER SET TEXT "
2030 LA2$="LAYER SET 0 ":PN$="Pt"
2040 TL2=VAL(HT$)*1.5:TH2$=STR$(TL2):LT=LEN(TH2$):TH2$=MID$(TH2$,2,LT-1)
2050 T3$="TEXT"+" @"+TH2$+"<90 "+HT$+" 0"
2060 PRINT #2,P$
2070 PRINT #2,ORIGIN$
2080 PRINT #2,T$:PRINT #2,"TRANSIT"
2090 FOR I=1 TO 750
2100 GET #1,I
2110 IF A$="D" THEN 2260
2120 IF A$="E" THEN 2270
2130 GOSUB 2350 :' CONVEST ANGLE AND DISTANCE TO XYZ
2140 LOCATE 12,50:PRINT USING "###";I;
2150 PRINT #2,P$
2160 PRINT #2,DP$
2170 PRINT #2,LA$
2180 PRINT #2,T$
2190 PRINT #2,PN$+STR$(I)
2200 PRINT #2,T3$
2210 PRINT #2,ELEV$
2220 PRINT #2,T3$
2230 LET T2$=TEXT$
2240 PRINT #2,T2$
2250 PRINT #2,LA2$
2260 NEXT I
2270 '
2280 CLOSE
2290 LOCATE 14,10:PRINT"SURVEY DATA SUCCESSFULLY CONVERTED TO ACAD SCRIPT FILE!"
2300 LOCATE 16,15:PRINT "DATA SAVED IN ACAD SRIPT FILE ---->> ";AFILE$
2310 LOCATE 18,10:PRINT "X-Y-Z FORMAT SAVED IN ASCI FORMAT IN FILE -->>";OFILE$
2320 LOCATE 20,25:PRINT"Press any key to continue!";
2330 WHILE INKEY$="":WEND
2340 GOTO 190
2350 ' CALCULATE X,Y,& Z COORDINATES -----------------------------------------
2360 K=1:J=1
2370 LET C$=MID$(PTA$,K,J)
2380 IF C$= " " OR C$= "D" THEN 2400
2390 K=K+1:GOTO 2370
2400 AWH=VAL(LEFT$(PTA$,K-1))
2410 K=K+1:K2=K:J=1
2420 LET M$=MID$(PTA$,K,J)
2430 IF M$="" THEN AG=AWH:GOTO 2550
2440 IF M$="'" THEN 2460
2450 K=K+1:GOTO 2420
2460 M=VAL(MID$(PTA$,K2,K-1))
2470 AG=AWH+(M/60):K=K+1:K2=K:J=1
2480 SND$=(MID$(PTA$,K,J))
2490 IF SND$="" THEN AG=AG:GOTO 2550
2500 S=ASC(SND$)
2510 IF S=34 THEN 2530
2520 K=K+1:GOTO 2480
2530 S=VAL(MID$(PTA$,K2,K-K2))
2540 AG=AG+((S/60)*(1/60))
2550 AG=AG*(3.141592/180):D1$=MID$(STR$(CVS(PTD$)),2,8):D=VAL(D1$)
2560 XSCOR=(COS(AG)*D)+XORD:YSCOR=YORD-(SIN(AG)*D)
2570 ZSCOR=VAL(ELEV$):
2580 XSCOR$=STR$(XSCOR):YSCOR$=STR$(YSCOR)
2590 LX=LEN(XSCOR$):LY=LEN(YSCOR$):LZ=LEN(ZSCOR$)
2600 DP$=MID$(XSCOR$,2,LX-1)+","+MID$(YSCOR$,2,LY-1)
2610 IF ZSCOR=0 THEN 2630
2620 PRINT #3, USING "#####.##,";XSCOR;YSCOR;ZSCOR;:PRINT #3,TEXT$
2630 RETURN
D$(YSCOR$,2,LY-1)
2610 IF ZSCOR=0 THEN 2630
2620 PRINT #3, USING "#####.##,";XSCOR;YSCOR;ZSCOR;:PRINT
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/