附和导线平差程序

1、附和导线平差程序QBASIC由本人在网络上收集整理 DECLARE FUNCTION DEG! (X!)DECLARE FUNCTION DMS! (XX!)DECLARE FUNCTION XCHAR$ (XX!, N!)CLSPRINTPRINT " 附和导线平差程序(2.0R)"PRINT " 作者：徐振刚"PRINT " 1999年12月31日"PRINT "功能：本程序可以用来进行一般导线平差计算，包括附和导线、闭合导线和支导线，其中"PRINT " 闭合导线和支导线需对原始数据进行一定处理。&

2、quot;PRINT "备注：坐标计算误差5mm；角度计算误差0.5s"PRINTREM 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 -导线全长相对闭合差1A(I) = A(I - 1) + B(I) + 180IF A(I) > 360 THENA(I) = A(I) - 360END IFNEXT

3、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

4、(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 &q

5、uot;导线方位角闭合差 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

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 &q

7、uot;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$

8、(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 #

9、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 #1R

10、EM *PRINTPRINT "详细数据资料业已备份到 JHFY.OUT。"PRINTPRINT "按 ESC键 返回主菜单."DOLOOP UNTIL INKEY$ = CHR$(27)RUN "MAIN.BAS"ENDREM 将度分秒转换成度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

11、 DMS (XX)IF XX < 0 THENX = -XXELSEX = XXEND IFD = INT(X)M = INT(X - D) * 60)S = (X - D - M / 60) * 3600IF XX >= 0 THENDMS = D + M / 100 + S / 10000ELSEDMS = -1 * (D + M / 100 + S / 10000)END IFEND FUNCTIONREM 以字符串形式输出保留 N 位小数的 XFUNCTION XCHAR$ (XX, N)X = ABS(XX)R = INT(X)F = INT(X - R) * 10 N + .5)TEMP$ = MID$(STR$(F), 2)WHILE LEN(TEM