home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / autocad / autograf.pas < prev    next >
Pascal/Delphi Source File  |  1994-03-04  |  3KB  |  139 lines
  1.  
  2.  
  3. _______________
  4.  
  5. { These procedures generate AUTOCAD readable files in .DXF -format
  6.  
  7. init (filename) opens the file and outputs the first introductory
  8.                 remarks to it. The filename should have the extension .DXF.
  9.  
  10. movea(x,y)       moves the pen to a position x,y without drawing
  11.  
  12. drawa(x,y)       draws a line from the current position to x,y
  13.  
  14. finit            closes the file
  15.  
  16. }
  17.  
  18. type dxaugrafiletype=string[20];
  19.  
  20. var xmomaugraf,ymomaugraf:real;
  21.     dxaugrafile:text;
  22.  
  23. procedure init(filename:dxaugrafiletype);
  24. {open the file for output }
  25.  
  26. begin
  27.   assign(dxaugrafile,filename);
  28.   rewrite(dxaugrafile);
  29.   xmomaugraf:=0.;
  30.   ymomaugraf:=0.;
  31.   writeln(dxaugrafile,'0');
  32.   writeln(dxaugrafile,'SECTION');
  33.   writeln(dxaugrafile,'2');
  34.   writeln(dxaugrafile,'ENTITIES');
  35. end;
  36.  
  37. procedure finit;
  38. {close the file}
  39. begin
  40.   writeln(dxaugrafile,'0');
  41.   writeln(dxaugrafile,'ENDSEC');
  42.   writeln(dxaugrafile,'0');
  43.   writeln(dxaugrafile,'EOF');
  44.   close(dxaugrafile);
  45. end;
  46.  
  47. procedure movea(x,y:real);
  48. { moves the current pointer to a new position }
  49. begin
  50.   xmomaugraf:=x;
  51.   ymomaugraf:=y;
  52. end;
  53.  
  54. procedure drawa(x,y:real);
  55. { Draws a line from the current position to x,y }
  56. begin
  57.   writeln(dxaugrafile,'0');
  58.   writeln(dxaugrafile,'LINE');
  59.   writeln(dxaugrafile,'  8');
  60.   writeln(dxaugrafile,'0');
  61.   writeln(dxaugrafile,' 10');
  62.   writeln(dxaugrafile,xmomaugraf:8:6);
  63.   writeln(dxaugrafile,' 20');
  64.   writeln(dxaugrafile,ymomaugraf:8:6);
  65.   writeln(dxaugrafile,' 11');
  66.   writeln(dxaugrafile,x:8:6);
  67.   writeln(dxaugrafile,' 21');
  68.   writeln(dxaugrafile,y:8:6);
  69.   xmomaugraf:=x;
  70.   ymomaugraf:=y;
  71. end;
  72.  
  73. _____________________________
  74.  
  75. C
  76. C   These subroutines produce output to a file that can be read by
  77. C   the AUTOCAD package as .DXF files with the command DXFIN.
  78. C
  79. C   CALL INIT(filename,ichannel) opens the file on channel
  80. C        ICHANNEL and outputs the first introductory lines
  81. C        to it. Filename should have the extension '.DXF'.
  82. C
  83. C   CALL MOVEA(X,Y)  moves the pen to a position X,Y without
  84. C        drawing
  85. C
  86. C   CALL DRAWA(X,Y)  draws a line from the last current position
  87. C        to X,Y
  88. C
  89. C   CALL FINIT closes the file
  90. C
  91. C
  92.       SUBROUTINE INIT(FILNAM,ICHAN)
  93. C
  94. C  *** Program was written for Fortran 77 - modify the following
  95. C      line for FIV.    
  96.       CHARACTER*20 FILNAM
  97.       COMMON /AUTOGR/ICHAN1,XMOM,YMOM
  98. C
  99. C     OPENING THE FILE FOR DXF
  100.       OPEN(ICHAN,FILE=FILNAM,STATUS='UNKNOWN' )
  101.       ICHAN1=ICHAN
  102.       XMOM=0
  103.       YMOM=0
  104. C
  105.       WRITE(ICHAN,1000)
  106. 1000  FORMAT('0',/'SECTION'/,'2',/'ENTITIES')
  107.       RETURN
  108.       END
  109.  
  110.  
  111.       SUBROUTINE FINIT
  112.       COMMON /AUTOGR/ICHAN1,XMOM,YMOM
  113.       WRITE(ICHAN1,1000)
  114. 1000  FORMAT('0'/ 'ENDSEC' /'0'/'EOF'/)
  115.       CLOSE(ICHAN1)
  116.       RETURN
  117.       END
  118.  
  119.       SUBROUTINE MOVEA(X,Y)
  120. C
  121. C     MOVES THE CURRENT POINTER TO A NEW POSITION
  122.       COMMON /AUTOGR/ICHAN1,XMOM,YMOM
  123.       XMOM=X
  124.       YMOM=Y
  125.       RETURN
  126.       END
  127.  
  128.       SUBROUTINE DRAWA(X,Y)
  129. C
  130. C     DRAWS A LINE FROM THE CURRENT POSITION  TO X,Y
  131.       COMMON /AUTOGR/ICHAN1,XMOM,YMOM
  132.       WRITE(ICHAN1,1000) XMOM,YMOM,X,Y
  133. 1000  FORMAT('0' / 'LINE' /'  8'/ '0' / ' 10' /F15.7 /' 20' /
  134.      %  F15.7/ ' 11'/ F15.7 / ' 21' / F15.7)
  135.      XMOM=X
  136.      YMOM=Y
  137.      RETURN
  138.      END
  139.