- 积分
- 23696
- 明经币
- 个
- 注册时间
- 2003-7-8
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2004-9-13 21:44:00
|
显示全部楼层
网上收集的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"
- 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 ----导线全长相对闭合差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.141592653589793#: 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 IS = 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) <= F0 THEN
- 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) <= F0 THEN
- 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"
- ENDREM 将度分秒转换成度
- 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 FUNCTIONREM 将度转换成度分秒
- FUNCTION DMS (XX)
- IF XX < 0 THEN
- 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 FUNCTIONREM 以字符串形式输出保留 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$) < N
- TEMP$ = "0" + TEMP$
- WEND
- TEMP$ = STR$(R) + "." + TEMP$
- IF XX >= 0 THEN
- XCHAR$ = TEMP$
- ELSE
- XCHAR$ = "-" + MID$(TEMP$, 2)
- END IF
- END FUNCTION
复制代码 |
|