home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / UTILITIE.PAK / DXF.M < prev    next >
Encoding:
Text File  |  1992-07-29  |  6.0 KB  |  229 lines
  1. (* :Title: DXF *)
  2.  
  3. (* :Context: Utilities`DXF` *)
  4.  
  5. (* :Author: John M. Novak *)
  6.  
  7. (* :Summary: Write a Graphics3D to a file in the AutoCAD 
  8.     dxf format. *)
  9.  
  10. (* :Package Version: 1.0 *)
  11.  
  12. (* :Mathematica Version: 2.0 *)
  13.  
  14. (* :History:
  15.     V1.0, Aug. 91, John M. Novak
  16. *)
  17.  
  18. (* :Keywords:
  19.     graphic interchange format, Graphics3D, AutoCAD, DXF
  20. *)
  21.  
  22. (* :Sources:
  23.     AutoCAD Release 10 Reference Manual, (Autodesk: 1989)
  24. *)
  25.  
  26. (* :Limitation:  Currently, only the transer of the objects,
  27.     not their style, is supported. (Thus, all lines will be
  28.     solid, etc.) *)
  29.  
  30. (* :Limitation: Transfer of axes, grid lines, tick marks, etc.
  31.     is not currently supported. *)
  32.  
  33. (* :Limitation: Currently, transfer of view position, etc. is
  34.     not supported. *)
  35.  
  36. (* :Limitation: Scaled coordinates cannot be handled by the
  37.     dxf format. *)
  38.  
  39. (* :Limitation: Text is not yet handled by the translation
  40.     function. *)
  41.  
  42. (* :Limitation: Currently supports only output of Graphics3D
  43.     (ie, SurfaceGraphics, etc. need to be converted to
  44.     Graphics3D before WriteDXF... *)
  45.  
  46. BeginPackage["Utilities`DXF`"]
  47.  
  48. WriteDXF::usage = 
  49.     "WriteDXF[filename,graphics3D] writes the graphic to the
  50.     file specified by the string filename in the AutoCAD .dxf
  51.     format.  The option PolygonsOnly will allow only polygons
  52.     to be written.";
  53.  
  54. PolygonsOnly::usage =
  55.     "An option for WriteDXF.  When True, only polygons will be
  56.     written to the dxf file.";
  57.  
  58. Begin["`Private`"]
  59.  
  60. Options[WriteDXF] =
  61.     {
  62.     PolygonsOnly -> False};
  63.  
  64. (* The options WriteAxes -> False, WriteStyles -> False,
  65.     are yet to be implemented. *)
  66.  
  67. WriteDXF::notmp = "Unable to open temporary junk file.";
  68.  
  69. WriteDXF::noopen = "Unable to open output file.";
  70.  
  71. WriteDXF[filename_String,Graphics3D[pic_,gopts___],opts___] :=
  72.     Module[{ax,st,po,tmpfile,gr,stream},
  73.         {po} = Map[TrueQ,{PolygonsOnly}/.
  74.             {opts}/.Options[WriteDXF]];
  75.         (* Note: The WriteAxes and WriteStyles options have
  76.             not yet been implemented. Store in ax, st.*)
  77.         (* get drawable parts - when styles is true,
  78.             walk the graphic tree to get a flat structure with
  79.             the exact style for each part associated with that
  80.             part. Separate polygons with more than 4 pts. *)
  81.         parts = Cases[pic,(Polygon[_?(Length[#] <= 4 &)] | 
  82.                 _Line | _Point),
  83.             Infinity];
  84.         (* Add Text to the above when know how to do it. *)
  85.         bparts = Cases[pic,(Polygon[_?(Length[#] > 4 &)] |
  86.                 _Cuboid),
  87.             Infinity];
  88.         stream = OpenWrite[filename];
  89.         If[Head[stream] =!= OutputStream,
  90.             Message[WriteDXF::noopen];Return[$Failed]];
  91.         tmpfile = OpenTemporary[];
  92.         If[Head[tmpfile] =!= OutputStream,
  93.             Message[WriteDXF::notmp];Return[$Failed]];
  94.         bparts = Display[tmpfile,
  95.             Graphics3D[Prepend[bparts,EdgeForm[]],
  96.                 PolygonIntersections->False]
  97.             ];
  98.         DeleteFile[Close[tmpfile]];
  99.         (* Modify this when styles is true. Also, add axes
  100.             grids, etc. to this when axes is true. *)
  101.         parts = Join[Cases[bparts,_Polygon,Infinity],
  102.             parts];
  103.         (* Do the following when styles are true:
  104.             If[st,
  105.                 header[stream];
  106.                 tables[stream]
  107.             ];
  108.         *)
  109.         If[op,
  110.             parts = Cases[parts,_Polygon,Infinity]
  111.         ];
  112.         entities[stream,parts];
  113.         endoffile[stream];
  114.         Close[stream]
  115.     ]
  116.  
  117. cr = "\n";
  118.  
  119. (* Implement the following two when sufficient information
  120.     is being written to require them - e.g. viewpoint,
  121.     linetypes, etc. *)
  122.  
  123. (* header[stream_OutputStream] *)
  124.  
  125. (* tables[stream_OutputStream] *)
  126.  
  127. entities[stream_,graph_] :=
  128.     (writegroup[stream,0,"SECTION",2,"ENTITIES"];
  129.     Scan[entity[stream,#]&,graph];
  130.     writegroup[stream,0,"ENDSEC"];)
  131.  
  132. entity[stream_OutputStream,ent:(p_Polygon | {st___,p_Polygon})] :=
  133.     Module[{poly},
  134.         writegroup[stream,0,"3DFACE",    (* entity type *)
  135.             8,0];                          (* layer name *)
  136.         If[Head[ent] === List,
  137.              (* do something with style info. *)
  138.         ];
  139.         If[Length[ p[[1]] ] == 3,
  140.             poly = Append[p[[1]],Last[ p[[1]] ] ],
  141.             poly = p[[1]]
  142.         ];
  143.         MapIndexed[writecoord[stream,#1,#2]&,poly ];
  144.     ]
  145.  
  146. entity[stream_OutputStream,ent:(l_Line | {st___,l_Line})] :=
  147.     Module[{line},
  148.         writegroup[stream,
  149.             0,"POLYLINE",  (* entity type *)
  150.             8,0,           (* layer name *)
  151.             66,1,          (* 'vertices follow' *)
  152.             70,8];         (* this is 3D Polyline *)
  153.         If[Head[ent] === List,
  154.             (* do something with style info - e.g., thickness *),
  155.             writegroup[stream,40,.01,41,.01];
  156.         ];
  157.         Scan[writevertex[stream,#,32]&,l[[1]]];
  158.         writegroup[stream,0,"SEQEND"];
  159.     ]
  160.  
  161. entity[stream_OutputStream,ent:(p_Point | {st___,p_Point})] :=
  162.     (writegroup[stream,
  163.             0,"POINT",
  164.             8,0];
  165.     If[Head[ent] === List,
  166.         (* do something with style info - e.g., pointsize. *)
  167.     ];
  168.     writecoord[stream,p[[1]],{1}];)
  169.  
  170. endoffile[stream_OutputStream] :=
  171.     writegroup[stream,0,"EOF"]
  172.  
  173. writevertex[stream_OutputStream,pts_,flag_] :=
  174.     (writegroup[stream,0,"VERTEX",8,0,42,0,70,flag];
  175.     writecoord[stream,pts,{1}])
  176.  
  177. writecoord[stream_OutputStream,pts_List,{num_Integer}] :=
  178.     MapIndexed[writegroup[stream,First[#2] * 10 + num - 1,#1]&,
  179.         pts]
  180.  
  181. writegroup[stream_,groups___] :=
  182.     Apply[writegroup[stream,##]&,Partition[{groups},2],{1}]/;
  183.         Length[{groups}] > 2
  184.  
  185. writegroup[stream_OutputStream,code_Integer,it_String] :=
  186.     WriteString[stream,rightjustifynum[code],cr,
  187.         it,cr]
  188.  
  189. writegroup[stream_OutputStream,code_Integer,it_] :=
  190.     WriteString[stream,rightjustifynum[code],cr,
  191.         ToString[CForm[it]],cr]
  192.  
  193. rightjustifynum[int_Integer?(#<10&)] :=
  194.     StringJoin["  ",ToString[int]]
  195.  
  196. rightjustifynum[int_Integer?(#<100&)] :=
  197.     StringJoin[" ",ToString[int]]
  198.  
  199. rightjustifynum[int_Integer?(#<1000)&] :=
  200.     ToString[int]
  201.  
  202. End[]
  203.  
  204. EndPackage[]
  205.  
  206. (* :Examples:
  207.  
  208. (* A surface. *)
  209.  
  210. gr = Plot3D[BesselJ[0,Sqrt[x^2 + y^2]],{x,-6,6},{y,-6,6},
  211.     PlotPoints->20];
  212.     
  213. gr = Graphics3D[gr];
  214.  
  215. WriteDXF["bessel.dxf",gr]
  216.  
  217. (* some of the shapes that can be transferred *)
  218.  
  219. gr2 = Graphics3D[{
  220.     Cuboid[{0,0,0}],Polygon[{{0,0,1},{1/2,0,2},{1/2,1,2},
  221.         {0,1,1}}], Polygon[{{0,0,0},{-1,0,-1},{-1,1,1/2},
  222.         {-2,-2,-2},{-1,-3,0}}], Line[{{1,1,1},{2,1,1},
  223.         {2,2,2},{1,2,2},{1,2,3},{3,3,3}}],
  224.         Point[{.5,.5,.5}]}];
  225.  
  226. WriteDXF["misc.dxf",gr2]
  227.  
  228. *)
  229.