附和导线平差程序

附和导线平差程序[QBASIC]

由本人在网络上收集整理

DECLARE FUNCTION DEG! (X!)

DECLARE FUNCTION DMS! (XX!)

DECLARE FUNCTION XCHAR$ (XX!, N!)

CLS

PRINT

PRINT " 附和导线平差程序(2.0R)"

PRINT " 作者：徐振刚"

PRINT " 1999年12月31日"

PRINT " 功能：本程序可以用来进行一般导线平差计算，包括附和导线、闭合导线和支导线，其中"

PRINT " 闭合导线和支导线需对原始数据进行一定处理。"

PRINT "备注：坐标计算误差≤5mm；角度计算误差≤0.5s"

PRINT

REM N ----角度个数(包括已知方位角)

REM M ----导线边数

REM H ----允许方位角闭合差秒值

REM A ----方位角(A(0)为起始方位角)

REM D ----边长

REM X,Y ----坐标(X1,Y1;X,Y为已知坐标)

REM F0 ----方位角允许闭合差

REM F1 ----导线方位角闭合差

REM F3,F4,F----增量闭合差

REM K ----导线全长相对闭合差

PRINT "新建数据文件?(Y/N)"

LOCATE 25: PRINT "按 ESC键 返回主菜单."; TAB(60); DATE$; " "; TIME$

DO

YN$ = INKEY$

IF YN$ = "Y" OR TN$ = "y" THEN

RUN "DXPCEDIT.BAS"

ELSEIF YN$ = "N" OR YN$ = "n" THEN

EXIT DO

ELSEIF YN$=CHR$(27) THEN

RUN "MAIN.BAS"

END IF

LOOP

REM

********************************************************************************

CLS

PI = 3.[**************]#: PU = 180 / PI

INPUT "请输入数据文件名:(DXPC.DAT)"; FILEIN$

IF FILEIN$ = "" THEN

FILEIN$ = "DXPC.DAT"

END IF

OPEN FILEIN$ FOR INPUT AS #1

INPUT #1, N, M, H

DIM B(N), D(M), A(N - 1), X(M), Y(M)

INPUT #1, X1, Y1, X, Y

FOR I = 0 TO N

INPUT #1, B(I)

B(I) = DEG(B(I))

NEXT I

FOR I = 1 TO M

INPUT #1, D(I)

NEXT I

CLOSE #1

REM

********************************************************************************

A(0) = B(0)

FOR I = 1 TO N - 1

A(I) = A(I - 1) + B(I) + 180

IF A(I) > 360 THEN

A(I) = A(I) - 360

END IF

NEXT I

F0 = H / 3600 * SQR(N - 1): F1 = A(N - 1) - B(N)

V = -1 * F1 / (N - 1)

FOR I = 1 TO N - 1

A(I) = A(I) + V * I

IF A(I) > 360 THEN

A(I) = A(I) - 360

END IF

NEXT I

S = 0: X(0) = X1: Y(0) = Y1

FOR I = 1 TO M

S = S + D(I)

X(I) = X(I - 1) + D(I) * COS(A(I) / PU)

Y(I) = Y(I - 1) + D(I) * SIN(A(I) / PU)

NEXT I

F3 = X(M) - X: F4 = Y(M) - Y: F = ABS(SQR(F3 * F3 + F4 * F4))

D = 0

FOR I = 1 TO M

D = D + D(I)

X(I) = X(I) - F3 / S * D

Y(I) = Y(I) - F4 / S * D

NEXT I

REM

********************************************************************************

PRINT "方位角允许闭合差 F0=+/-"; XCHAR$(DMS(F0), 6)

IF ABS(F1)

PRINT "导线方位角闭合差 F1= "; XCHAR$(DMS(F1), 6); " OK!"

ELSE

PRINT "导线方位角闭合差 F1= "; XCHAR$(DMS(F1), 6); " OVER LIMIT!"

END IF

PRINT "相对闭合差:"

PRINT TAB(5); "F3="; F3, "F4="; F4, "F="; F, "K=1/"; S / F

PRINT "改正后方位角:"

FOR I = 0 TO N - 1

PRINT TAB(5); "A("; I; ")="; XCHAR$(DMS(A(I)), 6)

NEXT I

PRINT "改正后坐标:"

FOR I = 0 TO M

PRINT TAB(5); "X("; I; ")="; XCHAR$(X(I), 4), TAB(30); "Y("; I; ")="; XCHAR$(Y(I), 4)

NEXT I

PRINT TAB(5); "X("; M; ")="; XCHAR$(X(M), 4), TAB(30); "Y("; M; ")="; XCHAR$(Y(M), 4)

OPEN "DXPC.OUT" FOR OUTPUT AS #1

PRINT #1, " 导线平差"

PRINT #1, TAB(25); DATE$, TIME$

PRINT #1,

PRINT #1, "方位角允许闭合差 F0=+/-"; XCHAR$(DMS(F0), 6)

IF ABS(F1)

PRINT #1, "导线方位角闭合差 F1= "; XCHAR$(DMS(F1), 6); " OK!"

ELSE

PRINT #1, "导线方位角闭合差 F1= "; XCHAR$(DMS(F1), 6); " OVER LIMIT!"

END IF

PRINT #1, "相对闭合差:"

PRINT #1, TAB(5); "F3="; F3, "F4="; F4, "F="; F, "K=1/"; S / F

PRINT #1, "改正后方位角:"

FOR I = 0 TO N - 1

PRINT #1, TAB(5); "A("; I; ")="; XCHAR$(DMS(A(I)), 6)

NEXT I

PRINT #1, "改正后坐标:"

FOR I = 0 TO M

PRINT #1, TAB(5); "X("; I; ")="; XCHAR$(X(I), 4), TAB(30); "Y("; I; ")="; XCHAR$(Y(I), 4)

NEXT I

PRINT #1, TAB(5); "X("; M; ")="; XCHAR$(X(M), 4), TAB(30); "Y("; M; ")="; XCHAR$(Y(M), 4)

CLOSE #1

REM

********************************************************************************

PRINT

PRINT "详细数据资料业已备份到 JHFY.OUT。"

PRINT

PRINT "按 ESC键 返回主菜单..."

DO

LOOP UNTIL INKEY$ = CHR$(27)

RUN "MAIN.BAS"

END

REM 将度分秒转换成度

FUNCTION DEG (X)

D = INT(X)

M = INT((X - D) * 100)

S = INT((X - D - M / 100) * 1000000) / 100

DEG = D + M / 60 + S / 3600

END FUNCTION

REM 将度转换成度分秒

FUNCTION DMS (XX)

IF XX

X = -XX

ELSE

X = XX

END IF

D = INT(X)

M = INT((X - D) * 60)

S = (X - D - M / 60) * 3600

IF XX >= 0 THEN

DMS = D + M / 100 + S / 10000

ELSE

DMS = -1 * (D + M / 100 + S / 10000)

END IF

END FUNCTION

REM 以字符串形式输出保留 N 位小数的 X FUNCTION XCHAR$ (XX, N)

X = ABS(XX)

R = INT(X)

F = INT((X - R) * 10 ^ N + .5) TEMP$ = MID$(STR$(F), 2)

WHILE LEN(TEMP$)

TEMP$ = "0" + TEMP$

WEND

TEMP$ = STR$(R) + "." + TEMP$ IF XX >= 0 THEN

XCHAR$ = TEMP$

ELSE

XCHAR$ = "-" + MID$(TEMP$, 2) END IF

END FUNCTION