附和导线平差程序.doc

附和导线平差程序QBASIC由本人在网络上收集整理 DECLARE FUNCTION DEG! (X!)DECLARE FUNCTION DMS! (XX!)DECLARE FUNCTION XCHAR$ (XX!, N!)CLSPRINTPRINT 附和导线平差程序(2.0R)PRINT 作者：徐振刚PRINT 1999年12月31日PRINT 功能：本程序可以用来进行一般导线平差计算，包括附和导线、闭合导线和支导线，其中PRINT 闭合导线和支导线需对原始数据进行一定处理。PRINT 备注：坐标计算误差5mm；角度计算误差0.5sPRINTREM 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$DOYN$ = INKEY$IF YN$ = Y OR TN$ = y THENRUN DXPCEDIT.BASELSEIF YN$ = N OR YN$ = n THENEXIT DOELSEIF YN$=CHR$(27) THENRUN MAIN.BASEND IFLOOPREM *CLSPI = 3.141592653589793#: PU = 180 / PIINPUT 请输入数据文件名:(DXPC.DAT); FILEIN$IF FILEIN$ = THENFILEIN$ = DXPC.DATEND IFOPEN FILEIN$ FOR INPUT AS #1INPUT #1, N, M, HDIM B(N), D(M), A(N - 1), X(M), Y(M)INPUT #1, X1, Y1, X, YFOR I = 0 TO NINPUT #1, B(I)B(I) = DEG(B(I)NEXT IFOR I = 1 TO MINPUT #1, D(I)NEXT ICLOSE #1REM *A(0) = B(0)FOR I = 1 TO N - 1A(I) = A(I - 1) + B(I) + 180IF A(I) 360 THENA(I) = A(I) - 360END IFNEXT IF0 = H / 3600 * SQR(N - 1): F1 = A(N - 1) - B(N)V = -1 * F1 / (N - 1)FOR I = 1 TO N - 1A(I) = A(I) + V * IIF A(I) 360 THENA(I) = A(I) - 360END IFNEXT IS = 0: X(0) = X1: Y(0) = Y1FOR I = 1 TO MS = 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 IF3 = X(M) - X: F4 = Y(M) - Y: F = ABS(SQR(F3 * F3 + F4 * F4)D = 0FOR I = 1 TO MD = D + D(I)X(I) = X(I) - F3 / S * DY(I) = Y(I) - F4 / S * DNEXT IREM *PRINT 方位角允许闭合差 F0=+/-; XCHAR$(DMS(F0), 6)IF ABS(F1) = F0 THENPRINT 导线方位角闭合差 F1= ; XCHAR$(DMS(F1), 6); OK!ELSEPRINT 导线方位角闭合差 F1= ; XCHAR$(DMS(F1), 6); OVER LIMIT!END IFPRINT 相对闭合差:PRINT TAB(5); F3=; F3, F4=; F4, F=; F, K=1/; S / FPRINT 改正后方位角:FOR I = 0 TO N - 1PRINT TAB(5); A(; I; )=; XCHAR$(DMS(A(I), 6)NEXT IPRINT 改正后坐标:FOR I = 0 TO MPRINT TAB(5); X(; I; )=; XCHAR$(X(I), 4), TAB(30); Y(; I; )=; XCHAR$(Y(I), 4)NEXT IPRINT TAB(5); X(; M; )=; XCHAR$(X(M), 4), TAB(30); Y(; M; )=; XCHAR$(Y(M), 4)OPEN DXPC.OUT FOR OUTPUT AS #1PRINT #1, 导线平差PRINT #1, TAB(25); DATE$, TIME$PRINT #1,PRINT #1, 方位角允许闭合差 F0=+/-; XCHAR$(DMS(F0), 6)IF ABS(F1) = F0 THENPRINT #1, 导线方位角闭合差 F1= ; XCHAR$(DMS(F1), 6); OK!ELSEPRINT #1, 导线方位角闭合差 F1= ; XCHAR$(DMS(F1), 6); OVER LIMIT!END IFPRINT #1, 相对闭合差:PRINT #1, TAB(5); F3=; F3, F4=; F4, F=; F, K=1/; S / FPRINT #1, 改正后方位角:FOR I = 0 TO N - 1PRINT #1, TAB(5); A(; I; )=; XCHAR$(DMS(A(I), 6)NEXT IPRINT #1, 改正后坐标:FOR I = 0 TO MPRINT #1, TAB(5); X(; I; )=; XCHAR$(X(I), 4), TAB(30); Y(; I; )=; XCHAR$(Y(I), 4)NEXT IPRINT #1, TAB(5); X(; M; )=; XCHAR$(X(M), 4), TAB(30); Y(; M; )=; XCHAR$(Y(M), 4)CLOSE #1REM *PRINTPRINT 详细数据资料业已备份到 JHFY.OUT。PRINTPRINT 按 ESC键 返回主菜单.DOLOOP UNTIL INKEY$ = CHR$(27)RUN MAIN.BASENDREM 将度分秒转换成度FUNCTION DEG (X)D = INT(X)M = INT(X - D) * 100)S = INT(X - D - M / 100) * 1000000) / 100DEG = D + M / 60 + S / 3600END FUNCTIONREM 将度转换成度分秒FUNCTION DMS (XX)IF XX = 0 THENDMS = D + M / 100 + S / 10000ELSEDMS = -1 * (D + M / 100 + S / 10000)END IFEND FUNCTIONREM 以字符串形式输出保留 N 位小数的 XFUNCTION XCHAR$ (XX, N