Подпрограмма RAZMERN. Изображение выносных и размерных

В файле RAZMERN.F90 содержатся две подпрограммы - RAZMERN и IMAGERZM.

! SUBROUTINE RAZMERN(V,kk,dlV,IArr,hv,rmx,rmy)

!Пп рисует выносные и размерные (со стрелками)линии. Первая выносная линия !является продолжением направленного отрезка, который начинается в точке V(2) и !заканчивается в точке V(l) (при этом выносная выходит за V(l) на длину dIV).

!Вторая выносная линия является продолжением направленного отрезка, который начинается в точке V(4) и заканчивается в точке V(3)(npn этом выносная выходит !за V(3) на длину dIV). Размерная линия проходит между выносными и отодвинута !от точек V(l) и V(3) на 0.8*dlV (0.8 длины выносной линии).

!При вызове данной пп точки /(их всего 4 шт.д.е.при вызове пп полагать kk=4)

!представляют структуру (составной тип, он же производный тип данных). Поэтому !перед обращением к пп в вызывающей программе каждой точке V должны быть при- !своены значения х- и у- координат в следующем виде: V(l)%x= ххх; V(l)%y= ххх;

!V(2)%x= ххх; V(2)%y= ххх; и т.д, где ххх - это соответствующее вещественное Число двойной точности (REAL*8) (т.е. свои х- и у- координыты точки для V(l),

!для /(2),для V(3) и для V(4).

SUBROUTINE RAZMERN(V,kk,dlV,IArr,hv,rmx,rmy)

USE MSFLIB; USE describe; IMPLICIT NONE INTEGER kk,NEWX*2,NEWY*2,i22*2

TYPE (xycoord) xy; ITYPE (fontinfo) fi; TYPE (windowconfig)myscreen TYPE (VERSH) V(kk)

REAL(8):: dlV,IArr,hv,xll,yl,x22,y2,x3,y3,x4,y4,xv,yv,xx,yt &

,rmx,rmy,xol,xo2,yol,yo2,dxV,dyV SddlV-длина выносной,IArr-дл.стрелки,hv-высота стр. ,xv2,yv2,alf,x0,y0,sina,cosa,dxArr,dyArr,dxhv,dyhv NEWX(xx)=INT2(xx*rmx+5d-l); NEWY(yt)=INT2(yt*rmy+5d-l)

xll=V(l)%x; yl=V(l)%y; x22=V(2)%x; y2=V(2)%y !Выносные направлены отт2 кт1 и за неё x3=V(3)%x; y3=V(3)%y; x4=V(4)%x; y4=V(4)%y !Выносные направлены от т4 к тЗ и за неё IF(xll/=x22.AND.yl/=y2) THEN

x0=-yl*(x22-xll)/(y2-yl)+xll !Прямая прох.ч/з т1 и т2 и пересекает ось X в хО при у=0

y0=-xll*(y2-yl)/(x22-xll)+yl !Прямая прох.ч/з т1 и т2 и пересекает ось Y в уО при х=0

alf=ATAND(yO/xO); !Угол прямой,прох.ч/з т1 и т2, с осью X

sina=SIND(alf); cosa=COSD(alf);dxV=dlV*cosa; dyV=dlV*sina !Приращ. коорд.конца выносной dxArr=IArr*sina; dyArr=IArr*cosa !Приращения к коорд-ам для опред. т. основан.стрелки dxhv=hv*cosa; dyhv=hv*sina !Приращ. к коорд-ам основ.стрелки для т. вершин стрелки if(xlly2) dxV=-dxV !Выносн.слева BK.Iversh=2 if(xll>x22.AND.yl

if(xll>x22.AND.yl>y2)then;dyV=-dyV;dxArr=-dxArr;dyArr=-dyArr;endif !Выносн. верх як. if(xll

CALL STRELA(xol,yol,dxArr,dyArr,dxhv,dyhv,rmx,rmy)

!верхи.стрелки у размерной слева от як.:

IF(xlly2)THEN; dxArr=-dxArr; dyArr=-dyArr;ENDIF !Рис. верхней стрелки у размерной справа от як.:

IF(xll>x22.AND.yl

if(xll>x22.AND.yl>y2)then; dxArr=-dxArr; dyArr=-dyArr;endif !Разм.сверху BK.Iversh=2 if(xll

CALL STRELA(xo2;yo2/dxArr/dyArr/dxhv,dyhv/rmx,rmy)

CALL moveto(NEWX(xll),-NEWY(yl),xy); i22=lineto(NEWX(xv),-NEWY(yv))!PHC.BbiHOCH.BKopB CALL moveto(NEWX(x3),-NEWY(y3),xy); i22=lineto(NEWX(xv2)/-NEWY(yv2))!Pnc.выноси.якоря CALL moveto(NEWX(xol),-NEWY(yol),xy); i22=lineto(NEWX(xo2)/-NEWY(yo2))!Pnc.pa3MepHbix CALL IMAGERZM ENDIF

if(xll==x22)then; !Узнал,что выносная вертикальная след-но размерная-гориз. if(y2>yl)then; yv=yl-dlV; yol=yl-(dlV-5d-4); endif !Выносная уходит вниз, у-коорд.её конца !на дл.выноси.меньше Точка отхода размерн.сдвин.на 0.8 выноси.(вниз от нач. выноси.) if(yl>y2)then; yv=yl+dlV; yol=yl+(dlV-5d-4);endif !Выносн.уходит вверх, у-коорд.её !конца на длину выносной больше у1 Т.отх. размерной сдвинута на 0.8 дл.выносной ! (вверх от начала выноси.) xv=xll; xv2=x3; yo2=yol;yv2=yv; xol=xll; хо2=хЗ;

CALL STRELA(xol,yol,IArr,0d0,0d0,hv,rmx,rmy)

CALL STRELA(xo2/yo2/-IArr/0d0/0d0/hv,rmx/rmy) endif

if(yl==y2)then !Узнал,что выносная гориз.,и след.размерная-вертикальна. if(xll>x22)then; xol=xll+(dlV-5d-4); xv=xll+dlV; endif !Выносная и размерная справа от обл. if(x22>xll)then; xol=xll-(dlV-5d-4); xv=xll-dlV; endif !Выносная и размерная слева от обл. yol=yl; уо2=уЗ; yv=yl; yv2=y3; xo2=xol;xv2=xv;

CALL STRELA(xol,yol,0d0,IArr,hv,0d0,rmx,rmy) Нижняя стрелка CALL STRELA(xo2,yo2,0d0,-IArr,hv,0d0,rmx,rmy) endif

CALL IMAGERZM

CALL moveto(NEWX(xll),NEWY(yl),xy); i22=lineto(NEWX(xv),NEWY(yv))!Pnc.BbiHOCHyra CALL moveto(NEWX(x3),NEWY(y3),xy); i22=lineto(NEWX(xv2)/NEWY(yv2))!Pиc.вынocнyю CALL moveto(NEWX(xol),NEWY(yol),xy); i22=lineto(NEWX(xo2)/NEWY(yo2))!Pa3MepHaB линия

CONTAINS

SUBROUTINE IMAGERZM INTEGERS):: i2d2; INTEGER ii

REAL(8):: alfl,r,xof,yof,sinal,cosal,dfont,xf,yf,xnachf,ynachf,longFd2 CHARACTER(8):: imgf

dfont=-2.5d-3 !Низ изобр.размера будет поднят над размерной на 5мм г=$(ЖГ((хо1-хо2)**2+(уо1-уо2)**2)!Вычисляю размер, кот.надо написать write(imgf,"(3p,f0.1)") г Перевожу его в символьный вид imgf=ADJUSTL(imgf) !Выравнивание текста по левой границе

ii=LEN_TRIM(imgf) !Длина записи без хвостовых пробелов в символах

i2d2=GETGTEXTEXTENT(imgf)/2.+0.5 !Половина длины изображения в пикселях longFd2=i2d2/(2d0*rmx) !Перевод в вещественные if(xol/=xo2.AND.yol/=yo2)then;

alfl=ATAND((yo2-yol)/(xo2-xol)); !Угол между размерной и осью X else; if(xol==xo2) alfl=90d0; if(yol==yo2) alfl=OdO endif

sinal=SIND(alfl);cosal=COSD(alfl)

xof=(xol+xo2)/2d0; yof=(yol+yo2)/2dO !Середина размерной линии IF (xol/=xo2.AND.yol/=yo2)THEN

xf=xof-dfont*sinal; yf=yof+dfont*cosal !Изобр.размера поднято на dfont над размерной xnachf=xf-longFd2*cosal; ynachf=yf-longFd2*sinal;!Ha4aao изобр.сдвинуто на 0.5 его длины ENDIF

IF (yol==yo2) THEN; xf=xof; yf=yof+dfont; xnachf=xf-longFd2; ynachf=yf; ENDIF IF (xol==xo2) THEN; xf=(xof-dfont); yf=yof; xnachf=xf;ynachf=yf-longFd2; ENDIF CALL SETGTEXTROTATION(IDNINT(alfl*ldl))

CALL moveto(NEWX(xnachf),NEWY(ynachf),xy); CALL outgtext(imgf)

CALL SETGTEXTROTATION(O)

END SUBROUTINE IMAGERZM END

Подпрограмма STRELA. Изображение стрелок размерных линий

Вызов: CALL STRELA(xo)yo,dxArr,dyArr,dxhv,dyhv/rmx,rmy)

SUBROUTINE STRELA(xo,yo,dxArr,dyArr,dxhv,dyhv,rmx,rmy)

USE MSFLIB; IMPLICIT NONE INTEGER NEWX*2,NEWY*2,i2*2 TYPE (xycoord) arr(3)

REAL(8):: x,y,xo,yo,x2,y2,x3,y3,rmx,rmy,xosns,dxArr,yosns,dyArr,dxhv,dyhv; NEWX(x)=INT2(x*rmx+5d-l); NEWY(y)=INT2(y*rmy+5d-l)

xosns=xo+dxArr; yosns=yo+dyArr;

x2=xosns+dxhv; y2=yosns-dyhv; x3=xosns-dxhv; y3=yosns+dyhv;

arr(l)%xcoord=NEWX(xo); arr(l)%ycoord=NEWY(yo) !Заполн.массива для постр.стрелки arr(2)%xcoord=NEWX(x2); arr(2)%ycoord=NEWY(y2) !Заполн.массива для постр.стрелки arr(3)%xcoord=NEWX(x3); arr(3)%ycoord=NEWY(y3) !Заполн.массива для постр.стрелки i2=POLYGON($GFILLINTERIOR,arr,3_2)

END

 
Посмотреть оригинал
< Пред   СОДЕРЖАНИЕ   ОРИГИНАЛ     След >