|
BY:lc.2
1 CLEAR
2 Q=11 ’交点个数加1
3 DIM D(Q),X(Q),Y(Q),R(Q),N1(Q),N2(Q),A(Q),C(Q),O(Q),G(Q),P1(Q),P2(Q),Q1(Q),Q2(Q),T1(Q),T2(Q),L(Q),M(Q)
4 D(0)=47264,X(0)=43026.0939,Y(0)=16948.5466 ’起点桩号和坐标
5 D(1)=48212.03,X(1)=42650.6693,Y(1)=16021.6936,R(1)=826.192,N1(1)=60,N2(1)=60
6 D(2)=49148.91,X(2)=41425.5219,Y(2)=16674.9305,R(2)=354.724,N1(2)=120,N2(2)=120
7 D(3)=49661.59,X(3)=40908.3058,Y(3)=16621.1706,R(3)=600,N1(3)=80,N2(3)=80
8 D(4)=50019.67,X(4)=40582.6132,Y(4)=16795.0457,R(4)=570.059,N1(4)=80,N2(4)=80
9 D(5)=50498.68,X(5)=40087.8038,Y(5)=16857.11,R(5)=1250,N1(5)=60,N2(5)=60
10 D(6)=51112.95,X(6)=39501.143,Y(6)=16807.7977,R(6)=600,N1(6)=80,N2(6)=80
11 D(7)=52113.01,X(7)=38603.5949,Y(7)=16360.1705,R(7)=400,N1(7)=100,N2(7)=100
12 D(8)=52962.43,X(8)=38138.5471,Y(8)=15642.5421,R(8)=910,N1(8)=100,N2(8)=100
13 D(9)=53677.91,X(9)=37406.98,Y(9)=15469.6681,R(9)=500,N1(9)=80,N2(9)=80
14 D(10)=54344.49,X(10)=36962.0015,Y(10)=14959.0062,R(10)=400,N1(10)=100,N2(10)=100 ’各交点桩号，坐标，半径，前后缓和曲线长度
15 D(11)=54700,X(11)=36662.0992,Y(11)=14951.3509 ’终点桩号及坐标
不同的公路,只改变Q值和各交点参数即可.本程式预留第4至第134行作为参数置入.
135 FOR U=1 TO Q-1
136 Y=POL (X(U)-X(U-1),Y(U)-Y(U-1)),A(U)=Z
137 IF A(U)<0 LET A(U)=360+A(U)
138 Y=POL (X(U+1)-X(U),Y(U+1)-Y(U)),C(U)=Z
139 IF C(U)<0 LET C(U)=360+C(U)
140 O(U)=ABS (C(U)-A(U))/2,G(U)=2*O(U)/(C(U)-A(U))
141 IF O(U)>90 LET O(U)=180-O(U),G(U)=-G(U)
142 P1(U)=N1(U)^2/24/R(U)-N1(U)^4/2688/R(U)^3
143 P2(U)=N2(U)^2/24/R(U)-N2(U)^4/2688/R(U)^3
144 Q1(U)=N1(U)/2-N1(U)^3/240/R(U)^2
145 Q2(U)=N2(U)/2-N2(U)^3/240/R(U)^2
146 T1(U)=(R(U)+P1(U))*TAN O(U)+Q1(U)-(P1(U)-P2(U))/SIN (2*O(U))
147 T2(U)=(R(U)+P2(U))*TAN O(U)+Q2(U)-(P1(U)-P2(U))/SIN (2*O(U))
148 L(U)=O(U)*PI *R(U)/90+(N1(U)+N2(U))/2
149 M(U)=ATN ((R(U)+P2(U))/(T2(U)-Q2(U)))
150 NEXT
300 *K:INPUT "LC= ";LC ’坐标正算
301 INPUT "BJ= ";BJ
302 K=1
303 IF BJ<0 LET BJ=-BJ,K=-1
304 IF LCD(Q) THEN PRINT "*ChuJie*":GOTO 300
305 U=0
306 U=U+1:IF LC>D(U)-T1(U)+L(U) THEN 306
307 IF U=Q LET U=Q-1
308 B$=" ":GOSUB 398
309 D=D(U),E=X(U),F=Y(U),R=R(U),N=N1(U),S=N2(U)
310 A=A(U),C=C(U),G=G(U),V=P2(U),T=T1(U),B=T2(U),L=L(U),M=M(U)
311 IF LC<=D-T THEN 317
312 IF LC>=D-T+L THEN 319
313 IF LC314 IF LC>D-T+L-S THEN 325
315 I=E+REC ((R+V)/SIN M,C+G*M),J=F+Z
316 I=I+REC (R-G*K*BJ,A+G*(180*(LC-D+T-N/2)/PI /R-90)),J=J+Z:GOTO 329
317 I=E-REC (D-LC,A),J=F-Z
318 I=I+REC (BJ,A+90*K),J=J+Z:GOTO 329
319 I=E+REC (LC-D+T-L+B,C),J=F+Z
320 I=I+REC (BJ,C+90*K),J=J+Z:GOTO 329
321 I=E-REC (T,A),J=F-Z
322 H=LC-D+T:GOSUB 335
323 I=I+REC (P,A+G*ATN (W/V)),J=J+Z
324 I=I+REC (BJ,A+90*G*H^2/PI /R/N+90*K),J=J+Z:GOTO 329
325 I=E+REC (B,C),J=F+Z
326 H=D-T+L-LC,N=S:GOSUB 335
327 I=I+REC (P,C+180-G*ATN (W/V)),J=J+Z
328 I=I+REC (BJ,C-90*G*H^2/PI /R/N+90*K),J=J+Z
329 Y=POL (I-X0,J-Y0)
330 IF Z<0 LET Z=360+Z
331 IF K=-1 LET BJ=-BJ
332 PRINT "LC=K";INT (LC/1000);"+";(LC/1000-INT (LC/1000))*1000;"BJ=";BJ;B$
333 PRINT "X=";INT (1000*I+0.5)/1000;"Y=";INT (1000*J+0.5)/1000
334 PRINT "FWJ=";INT (10000*(DMS Z)+0.5)/10000;"JL=";INT (1000*Y+0.5)/1000:GOTO 300
335 V=H-H^5/40/R^2/N^2+H^9/3456/R^4/N^4
336 W=H^3/6/R/N-H^7/336/R^3/N^3+H^11/42240/R^5/N^5
337 P=SQR (V^2+W^2):RETURN
338 *J:INPUT "FWJ= ";FW ’坐标反算桩号，输入测点到测站的距离和方位角。
339 INPUT "JL= ";JL
340 FW=DEG FW
341 I=X0+REC (JL,FW),J=Y0+Z
342 A$=" ":GOSUB 359
343 B$=" ":GOSUB 405
344 IF BJ<0 LET K=-1
345 BJ=INT (ABS BJ*1000+0.5)/1000
346 IF K=-1 LET BJ=-BJ
347 PRINT "FWJ=";INT (10000*(DMS FW)+0.5)/10000;"JL=";JL;A$
348 PRINT "X=";INT (1000*I+0.5)/1000;"Y=";INT (1000*J+0.5)/1000
349 PRINT "LC=K";INT (LC/1000);"+";INT ((LC/1000-INT (LC/1000))*1000000+0.5)/1000;"BJ=";BJ;B$:GOTO 338
350 *L:INPUT "X= ";I ’坐标反算桩号，输入坐标
351 INPUT "Y= ";J
352 A$=" ":GOSUB 359
353 B$=" ":GOSUB 405
354 IF BJ<0 LET K=-1
355 BJ=INT (ABS BJ*1000+0.5)/1000
356 IF K=-1 LET BJ=-BJ
357 PRINT "X=";I;"Y=";J;A$
358 PRINT "LC=K";INT (LC/1000);"+";INT ((LC/1000-INT (LC/1000))*1000000+0.5)/1000;"BJ=";BJ;B$:GOTO 350
359 FOR U=1 TO Q-2
360 GOSUB 387
361 IF L2362 NEXT
363 GOSUB 387
364 IF L1D(Q) THEN A$="*ChuJie*",LC=0,BJ=0:GOTO 386
365 D=D(U),E=X(U),F=Y(U),R=R(U),N=N1(U),S=N2(U)
366 A=A(U),C=C(U),G=G(U),V=P2(U),T=T1(U),B=T2(U),L=L(U),M=M(U)
367 LC=L1,BJ=-Y*SIN (Z-A-180)
368 IF LC<=D-T THEN 386
369 LC=L2,BJ=Y*SIN (Z-C)
370 IF LC>=D-T+L THEN 386
371 V=E+REC ((R+V)/SIN M,C+G*M),W=F+Z
372 O=A+G*(90*N/PI /R-90)
373 IF O<0 LET O=360+O
374 IF O>360 LET O=O-360
375 Y=POL (I-V,J-W)
376 IF Z<0 LET Z=360+Z
377 O=Z-O
378 IF O<-180 LET O=360+O
379 IF O>180 LET O=O-360
380 LC=D-T+N+O*G*PI *R/180,BJ=G*(R-Y)
381 IF LC382 IF LC>D-T+L-S THEN 385
383 GOTO 386
384 D=D-T,E=E-REC (T,A),F=F-Z:GOSUB 389:LC=D+LC:GOTO 386
385 D=D-T+L,E=E+REC (B,C),F=F+Z,A=C+180,G=-G,N=S:GOSUB 389:LC=D-LC,BJ=-BJ
386 RETURN
387 IF I=X(U) AND J=Y(U) LET I=I+0.0001
388 Y=POL (I-X(U),J-Y(U)),L1=D(U)-Y*COS (Z-A(U)-180),L2=D(U)-T1(U)+L(U)-T2(U)+Y*COS (Z-C(U)):RETURN
389 H=0,M=E,O=F
390 IF I=M AND J=O THEN LC=H,BJ=0:GOTO 397
391 Y=POL (I-M,J-O),Z=Z-A-90*G*H^2/PI /R/N
392 S=Y*COS Z:IF ABS S<0.005 THEN LC=H+S,BJ=Y*SIN Z:GOTO 397
393 H=H+S
394 IF H>N LET H=N
395 GOSUB 335
396 M=E+REC (P,A+G*ATN (W/V)),O=F+Z:GOTO 390
397 RETURN
398 IF LC>50673.5 AND LC<50700 THEN B$="*LC*Cuo*",LC=0:GOTO 404
399 IF LC>=D(5)-T1(5)+L(5) AND LC<=50673.5 THEN U=5:GOTO 404
400 IF LC>=50150 AND LC<=50167.16 THEN 401 ELSE 404
401 INPUT "K50+167.16=K50+150*CLQ?*Yes\No:";A$
402 IF A$="Y" THEN U=4:B$="*CLQ*":GOTO 404
403 U=5
404 RETURN
第398至第404行作为正算时处理断链所用,不同的工程应作相应调整.
405 IF U=6 AND LC<50700 THEN LC=LC-26.5:GOTO 408
406 IF U=4 AND LC>=50150 THEN B$="*CLQ*":GOTO 408
407 IF U=5 AND LC<=50150 THEN LC=LC+17.16,B$="*CLQ*"
408 RETURN
第405至第408行作为反算时处理断链所用,不同的工程应作相应调整.
说明：程序输入完成后，先运行RUN一次，以后只需运行G.*K(坐标正算),G.*J(输距离方位角反算),G.*L(输坐标反算)即可.测站坐标设为X0和Y0,在运行RUN后将测站坐标存入X0和Y0即可,注意,一旦运行过RUN,此后只在每次建站时存入测站坐标即可.
|
网站首页
