jsgc2005.for

此程序采用Fortern和AutoCAD中的脚本结合开发而成

	write(10,500)ks
	write(10,*)'text'
	write(10,*)'j'
	write(10,*)'m'
	if(itkds.eq.1) write(10,*)xzh,',-987.2'
	if(itkds.eq.1) write(10,*)'2'
	write(10,*)'90'
	write(10,400)hx(j)
	write(10,*)'text'
	write(10,*)'j'
	write(10,*)'m'
	if(itkds.eq.1) write(10,*)xzh,',-997.2'
	if(itkds.eq.1) write(10,*)'2'
	write(10,*)'90'
	write(10,400)hdd(j)
	write(10,*)'color'
	write(10,*)'bylayer'
	write(10,*)'line'
	write(10,*)kx(j),',-1001.8'
	if(itkds.eq.1) write(10,*)kx(j),',-969.8'
	write(10,*)
c-----输出桥墩编号----------------
	write(10,*)'color'
	write(10,*)'7'
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)kx(j),',-938.8'
	if(itkds.eq.1) write(10,*)kx(j),',-942.8'
	write(10,*)
	write(10,*)'circle'
	if(itkds.eq.1) write(10,*)kx(j),',-944.8'
	if(itkds.eq.1) write(10,*)'2'
	write(10,*)'text'
	write(10,*)'j'
	write(10,*)'m'
	if(itkds.eq.1) write(10,*)kx(j)-0.2,',-944.8'
      if(itkds.eq.1) write(10,*)'2'
	write(10,*)'0'
	ii=j-1
	write(10,606)ii
30     continue
	write(10,*)'color'
	write(10,*)'7'
	if(itkds.eq.1) dqd=kx(1)-25.0
	dzd=kx(m)+10.0
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)dqd,',-969.8'
	if(itkds.eq.1) write(10,*)dzd,',-969.8'
	write(10,*)
	if(itkds.eq.1) dqd1=kx(1)-9.0
	write(10,*)'color'
	write(10,*)'bylayer'
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)dqd1,',-1017.8'
	if(itkds.eq.1) write(10,*)dqd1,',-969.8'
	write(10,*)
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)dqd,',-981.8'
	if(itkds.eq.1) write(10,*)dzd,',-981.8'
	write(10,*)
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)dqd,',-991.8'
	if(itkds.eq.1) write(10,*)dzd,',-991.8'
	write(10,*)
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)dqd,',-1001.8'
	if(itkds.eq.1) write(10,*)dzd,',-1001.8'
	write(10,*)
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)dqd,',-1009.8'
	if(itkds.eq.1) write(10,*)dzd,',-1009.8'
	write(10,*)
	write(10,*)'color'
	write(10,*)'1'
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)dqd,',-1017.8'
	if(itkds.eq.1) write(10,*)dzd,',-1017.8'
	write(10,*)
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)dqd,',-1017.8'
	if(itkds.eq.1) write(10,*)dqd,',-969.8'
	write(10,*)
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)dzd,',-1017.8'
	if(itkds.eq.1) write(10,*)dzd,',-969.8'
	write(10,*)
	write(10,*)'textstyle'
	write(10,*)'hz'
	write(10,*)'color'
	write(10,*)'7'
	if(itkds.eq.1) a1=kx(1)-17.0
	write(10,*)'text'
	write(10,*)'j'
	write(10,*)'m'
	if(itkds.eq.1) write(10,*)a1,',-975.8'
      if(itkds.eq.1) write(10,*)'3'
	write(10,*)'0'
	write(10,*)'里程桩号'
	write(10,*)'text'
	write(10,*)'j'
	write(10,*)'m'
	if(itkds.eq.1) write(10,*)a1,',-986.8'
      if(itkds.eq.1) write(10,*)'3'
	write(10,*)'0'
	write(10,*)'设计高程'
	write(10,*)'text'
	write(10,*)'j'
	write(10,*)'m'
	if(itkds.eq.1) write(10,*)a1,',-996.8'
      if(itkds.eq.1) write(10,*)'3'
	write(10,*)'0'
	write(10,*)'地面高程'
	write(10,*)'text'
	write(10,*)'j'
	write(10,*)'m'
	if(itkds.eq.1) write(10,*)a1,',-1005.8'
      if(itkds.eq.1) write(10,*)'3'
	write(10,*)'0'
	write(10,*)'设计纵坡'
	write(10,*)'text'
	write(10,*)'j'
	write(10,*)'m'
	if(itkds.eq.1) write(10,*)a1,',-1013.8'
      if(itkds.eq.1) write(10,*)'3'
	write(10,*)'0'
	write(10,*)'竖曲线要素'
c-----绘制纵坡竖曲线数据----------------------------
	if(itkds.eq.1) x0=kx(1)-9
	do 80 i=2,n-1
	write(10,*)'textstyle'
	write(10,*)'hz'
	write(10,*)'color'
	write(10,*)'7'	
	if(kx(1).le.k0(i).and.k0(i).le.kx(m)) then
	       jkk=int(k0(i)/1000.0)
	       kkk=k0(i)-jkk*1000.0
	write(10,*)'text'
	if(itkds.eq.1) s1=k0(i)-37
	if(itkds.eq.1) write(10,*)s1,',-1016'
      if(itkds.eq.1) write(10,*)'2'
	write(10,*)'0'
	write(10,600)jkk,kkk
	write(10,*)'text'
	if(itkds.eq.1) s1=k0(i)-20
	if(itkds.eq.1) write(10,*)s1,',-1016'
      if(itkds.eq.1) write(10,*)'2'
	write(10,*)'0'
	write(10,601)h0(i)
	write(10,*)'text'
	if(itkds.eq.1) s1=k0(i)-7
	if(itkds.eq.1) write(10,*)s1,',-1016'
      if(itkds.eq.1) write(10,*)'2'
	write(10,*)'0'
	write(10,602)r(i)
	write(10,*)'text'
	if(itkds.eq.1) s1=k0(i)+10
	if(itkds.eq.1) write(10,*)s1,',-1016'
      if(itkds.eq.1) write(10,*)'2'
	write(10,*)'0'
	write(10,603)t(i)
	write(10,*)'text'
	if(itkds.eq.1) s1=k0(i)+25
	if(itkds.eq.1) write(10,*)s1,',-1016'
      if(itkds.eq.1) write(10,*)'2'
	write(10,*)'0'
	write(10,604)e(i)
	write(10,*)'color'
	write(10,*)'bylayer'	
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)k0(i),',-1009.8'
	if(itkds.eq.1) write(10,*)k0(i),',-1001.8'
	write(10,*)
	s2=k0(i)-t(i)
	s3=k0(i)+t(i)
	if(s(i-1).le.s(i)) then
	if(itkds.eq.1) y=-1013+5
	else
	if(itkds.eq.1) y=-1013-5
	endif
	write(10,*)'color'
	write(10,*)'bylayer'	
	write(10,*)'line'
	write(10,*)s2,',',y
	if(itkds.eq.1) write(10,*)s2,',-1013'
	if(itkds.eq.1) write(10,*)s3,',-1013'
	write(10,*)s3,',',y
	write(10,*)
c-------绘制纵坡线---------------------
	if(s(i-1).lt.0.0) then
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)x0,',-1001.8'
	if(itkds.eq.1) write(10,*)k0(i),',-1009.8'
	write(10,*)
	write(10,*)'color'
	write(10,*)'7'	
	write(10,*)'text'
	ss1=x0+0.5*(k0(i)-x0)
	if(itkds.eq.1) write(10,*)ss1,',-1004.8'
      if(itkds.eq.1) write(10,*)'2'
	write(10,*)'0'
	write(10,605)s(i-1)
	x0=k0(i)
	endif
	if(s(i-1).eq.0.0) then
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)x0,',-1005.8'
	if(itkds.eq.1) write(10,*)k0(i),',-1005.8'
	write(10,*)
	write(10,*)'color'
	write(10,*)'7'	
	write(10,*)'text'
	ss1=x0+0.5*(k0(i)-x0)
	if(itkds.eq.1) write(10,*)ss1,',-1004.8'
      if(itkds.eq.1) write(10,*)'2'
	write(10,*)'0'
	write(10,605)s(i-1)
	x0=k0(i)
	endif
	if(s(i-1).gt.0.0) then
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)x0,',-1009.8'
	if(itkds.eq.1) write(10,*)k0(i),',-1001.8'
	write(10,*)
	write(10,*)'color'
	write(10,*)'7'	
	write(10,*)'text'
	ss1=x0+0.5*(k0(i)-x0)
	if(itkds.eq.1) write(10,*)ss1,',-1008.8'
      if(itkds.eq.1) write(10,*)'2'
	write(10,*)'0'
	write(10,605)s(i-1)
	x0=k0(i)
	endif
	aa=k0(i)
	bb=s(i)
	endif
80	continue
	cc=kx(m)+10	
	if(bb.lt.0.0) then
	write(10,*)'color'
	write(10,*)'bylayer'
	write(10,*)'line'
	write(10,*)aa,',-1001.8'
	if(itkds.eq.1) write(10,*)cc,',-1009.8'
	write(10,*)
	write(10,*)'color'
	write(10,*)'7'	
	write(10,*)'text'
	ss1=aa+0.5*(kx(m)-aa)
	if(itkds.eq.1) write(10,*)ss1,',-1004.8'
      if(itkds.eq.1) write(10,*)'2'
	write(10,*)'0'
	write(10,605)bb
	endif
	if(bb.eq.0.0) then
	write(10,*)'color'
	write(10,*)'bylayer'
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)aa,',-1005.8'
	if(itkds.eq.1) write(10,*)cc,',-1005.8'
	write(10,*)
	write(10,*)'color'
	write(10,*)'7'	
	write(10,*)'text'
	ss1=aa+0.5*(kx(m)-aa)
	if(itkds.eq.1) write(10,*)ss1,',-1004.8'
      if(itkds.eq.1) write(10,*)'2'
	write(10,*)'0'
	write(10,605)bb
	endif
	if(bb.gt.0.0) then
	write(10,*)'color'
	write(10,*)'bylayer'
	write(10,*)'line'
	if(itkds.eq.1) write(10,*)aa,',-1009.8'
	if(itkds.eq.1) write(10,*)cc,',-1001.8'
	write(10,*)
	write(10,*)'color'
	write(10,*)'7'	
	write(10,*)'text'
	ss1=aa+0.5*(kx(m)-aa)
	if(itkds.eq.1) write(10,*)ss1,',-1008.8'
      if(itkds.eq.1) write(10,*)'2'
	write(10,*)'0'
	write(10,605)bb
	endif
	write(10,*)'color'
	write(10,*)'bylayer'
	write(10,*)'osmode'
	write(10,*)'1057'
	do 90 i=1,500
	write(10,*)'REDRAW'
90	continue
	write(10,*)'**桥梁高程计算程序CAD出图子模块 **'




200    format(1x,f10.3,',',f10.3)
100    format(f7.3,1x,f7.3,2x,'+',f7.3,3x,i3,1x,f11.3,3x,f5.2,
     $3x,f5.2)
300	 format(1x,i3,2x,'K',i3,'+',f7.3,1x,f6.3,1x,'R=',f10.3,1x,'T=',f8.
     1 3,1x,'E=',f6.3,1x,'q=',f6.3,'%',1x,'h=',f6.3,'%')
400	format(1x,f10.3)
500	format(1x,'+',f7.3)
600   format(1x,'K',i3,'+',f7.3)
601   format(1x,'H=',f10.3)
602   format(1x,'R=',f10.3)
603   format(1x,'T=',f10.3)
604   format(1x,'E=',f10.3)
605   format(1x,f10.3,'%')
606	format(1x,i3)
700   format(4x,f10.2,2x,f8.3,1x,f8.3,1x,f8.3,2x,f8.3,1x,f8.3)
701   format(4x,f10.2,2x,f8.3,1x,f8.3,1x,f8.3,2x,f8.3,1x,f8.3)
       write(*,*)
       write(*,*)'                  * * * *  谢谢使用!  * * * *'
       write(*,*)
       write(*,*)
       write(*,*)
       write(*,*)
       write(*,*)
       write(*,*)
       end