home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1994 September
/
Simtel-MSDOS-Sep1994-CD2.iso
/
disc2
/
autocad
/
autograf.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-08-13
|
3KB
|
139 lines
_______________
{ These procedures generate AUTOCAD readable files in .DXF -format
init (filename) opens the file and outputs the first introductory
remarks to it. The filename should have the extension .DXF.
movea(x,y) moves the pen to a position x,y without drawing
drawa(x,y) draws a line from the current position to x,y
finit closes the file
}
type dxaugrafiletype=string[20];
var xmomaugraf,ymomaugraf:real;
dxaugrafile:text;
procedure init(filename:dxaugrafiletype);
{open the file for output }
begin
assign(dxaugrafile,filename);
rewrite(dxaugrafile);
xmomaugraf:=0.;
ymomaugraf:=0.;
writeln(dxaugrafile,'0');
writeln(dxaugrafile,'SECTION');
writeln(dxaugrafile,'2');
writeln(dxaugrafile,'ENTITIES');
end;
procedure finit;
{close the file}
begin
writeln(dxaugrafile,'0');
writeln(dxaugrafile,'ENDSEC');
writeln(dxaugrafile,'0');
writeln(dxaugrafile,'EOF');
close(dxaugrafile);
end;
procedure movea(x,y:real);
{ moves the current pointer to a new position }
begin
xmomaugraf:=x;
ymomaugraf:=y;
end;
procedure drawa(x,y:real);
{ Draws a line from the current position to x,y }
begin
writeln(dxaugrafile,'0');
writeln(dxaugrafile,'LINE');
writeln(dxaugrafile,' 8');
writeln(dxaugrafile,'0');
writeln(dxaugrafile,' 10');
writeln(dxaugrafile,xmomaugraf:8:6);
writeln(dxaugrafile,' 20');
writeln(dxaugrafile,ymomaugraf:8:6);
writeln(dxaugrafile,' 11');
writeln(dxaugrafile,x:8:6);
writeln(dxaugrafile,' 21');
writeln(dxaugrafile,y:8:6);
xmomaugraf:=x;
ymomaugraf:=y;
end;
_____________________________
C
C These subroutines produce output to a file that can be read by
C the AUTOCAD package as .DXF files with the command DXFIN.
C
C CALL INIT(filename,ichannel) opens the file on channel
C ICHANNEL and outputs the first introductory lines
C to it. Filename should have the extension '.DXF'.
C
C CALL MOVEA(X,Y) moves the pen to a position X,Y without
C drawing
C
C CALL DRAWA(X,Y) draws a line from the last current position
C to X,Y
C
C CALL FINIT closes the file
C
C
SUBROUTINE INIT(FILNAM,ICHAN)
C
C *** Program was written for Fortran 77 - modify the following
C line for FIV.
CHARACTER*20 FILNAM
COMMON /AUTOGR/ICHAN1,XMOM,YMOM
C
C OPENING THE FILE FOR DXF
OPEN(ICHAN,FILE=FILNAM,STATUS='UNKNOWN' )
ICHAN1=ICHAN
XMOM=0
YMOM=0
C
WRITE(ICHAN,1000)
1000 FORMAT('0',/'SECTION'/,'2',/'ENTITIES')
RETURN
END
SUBROUTINE FINIT
COMMON /AUTOGR/ICHAN1,XMOM,YMOM
WRITE(ICHAN1,1000)
1000 FORMAT('0'/ 'ENDSEC' /'0'/'EOF'/)
CLOSE(ICHAN1)
RETURN
END
SUBROUTINE MOVEA(X,Y)
C
C MOVES THE CURRENT POINTER TO A NEW POSITION
COMMON /AUTOGR/ICHAN1,XMOM,YMOM
XMOM=X
YMOM=Y
RETURN
END
SUBROUTINE DRAWA(X,Y)
C
C DRAWS A LINE FROM THE CURRENT POSITION TO X,Y
COMMON /AUTOGR/ICHAN1,XMOM,YMOM
WRITE(ICHAN1,1000) XMOM,YMOM,X,Y
1000 FORMAT('0' / 'LINE' /' 8'/ '0' / ' 10' /F15.7 /' 20' /
% F15.7/ ' 11'/ F15.7 / ' 21' / F15.7)
XMOM=X
YMOM=Y
RETURN
END