Подпрограмма 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₂).

END.