(* :Title: DXF *)

(* :Context: Utilities`DXF` *)

(* :Author: John M. Novak *)

(* :Summary:
This package allows the export of Graphics3D objects to a file
in the AutoCAD DXF format.
*)

(* :Package Version: 1.0 *)

(* :Mathematica Version: 2.0 *)

(* :Copyright: Copyright 1991-1999, Wolfram Research, Inc.*)

(* :History:
	V1.0, August 1991, John M. Novak.
*)

(* :Keywords:
	graphic interchange format, Graphics3D, AutoCAD, DXF
*)

(* :Sources:
	AutoCAD Release 10 Reference Manual, (Autodesk: 1989).
*)

(* :Limitation:  Currently, only the transfer of the objects,
	not their style, is supported. (Thus, all lines will be
	solid, etc.) *)

(* :Limitation: Transfer of axes, grid lines, tick marks, etc.
	is not currently supported. *)

(* :Limitation: Currently, transfer of view position, etc. is
	not supported. *)

(* :Limitation: Scaled coordinates cannot be handled by the
	dxf format. *)

(* :Limitation: Text is not yet handled by the translation
	function. *)

(* :Limitation: Currently supports only output of Graphics3D
	(i.e., SurfaceGraphics, etc. need to be converted to
	Graphics3D before WriteDXF. *)

BeginPackage["Utilities`DXF`"]

WriteDXF::usage = 
	"WriteDXF[filename,graphics3D] writes the graphic to the
	file specified by the string filename in the AutoCAD .dxf
	format.  The option PolygonsOnly will allow only polygons
	to be written.";

PolygonsOnly::usage =
"PolygonsOnly is an option for WriteDXF.  When True, only polygons will be
written to the dxf file.";

Begin["`Private`"]

Options[WriteDXF] =
	{
	PolygonsOnly -> False};

(* The options WriteAxes -> False, WriteStyles -> False,
	are yet to be implemented. *)

WriteDXF::notmp = "Unable to open temporary junk file.";

WriteDXF::noopen = "Unable to open output file.";

WriteDXF[filename_String,Graphics3D[pic_,gopts___],opts___] :=
	Module[{ax,st,po,tmpfile,gr,stream},
		{po} = Map[TrueQ,{PolygonsOnly}/.
			{opts}/.Options[WriteDXF]];
		(* Note: The WriteAxes and WriteStyles options have
			not yet been implemented. Store in ax, st.*)
		(* get drawable parts - when styles is true,
			walk the graphic tree to get a flat structure with
			the exact style for each part associated with that
			part. Separate polygons with more than 4 pts. *)
		parts = Cases[pic,(Polygon[_?(Length[#] <= 4 &)] | 
				_Line | _Point),
			Infinity];
		(* Add Text to the above when know how to do it. *)
		bparts = Cases[pic,(Polygon[_?(Length[#] > 4 &)] |
				_Cuboid),
			Infinity];
		stream = OpenWrite[filename];
		If[Head[stream] =!= OutputStream,
			Message[WriteDXF::noopen];Return[$Failed]];
		tmpfile = OpenTemporary[];
		If[Head[tmpfile] =!= OutputStream,
			Message[WriteDXF::notmp];Return[$Failed]];
		bparts = Display[tmpfile,
			Graphics3D[Prepend[bparts,EdgeForm[]],
				PolygonIntersections->False]
			];
		DeleteFile[Close[tmpfile]];
		(* Modify this when styles is true. Also, add axes
			grids, etc. to this when axes is true. *)
		parts = Join[Cases[bparts,_Polygon,Infinity],
			parts];
		(* Do the following when styles are true:
			If[st,
				header[stream];
				tables[stream]
			];
		*)
		If[po,
			parts = Cases[parts,_Polygon,Infinity]
		];
		entities[stream,parts];
		endoffile[stream];
		Close[stream]
	]

cr = "\n";

(* Implement the following two when sufficient information
	is being written to require them - e.g. viewpoint,
	linetypes, etc. *)

(* header[stream_OutputStream] *)

(* tables[stream_OutputStream] *)

entities[stream_,graph_] :=
	(writegroup[stream,0,"SECTION",2,"ENTITIES"];
	Scan[entity[stream,#]&,graph];
	writegroup[stream,0,"ENDSEC"];)

entity[stream_OutputStream,ent:(p_Polygon | {st___,p_Polygon})] :=
	Module[{poly},
		writegroup[stream,0,"3DFACE",	(* entity type *)
			8,0];  						(* layer name *)
		If[Head[ent] === List,
			 (* do something with style info. *)
			 Null
		];
		If[Length[ p[[1]] ] == 3,
			poly = Append[p[[1]],Last[ p[[1]] ] ],
			poly = p[[1]]
		];
		MapIndexed[writecoord[stream,#1,#2]&,poly ];
	]

entity[stream_OutputStream,ent:(l_Line | {st___,l_Line})] :=
	Module[{line},
		writegroup[stream,
			0,"POLYLINE",  (* entity type *)
			8,0,           (* layer name *)
			66,1,          (* 'vertices follow' *)
			70,8];         (* this is 3D Polyline *)
		If[Head[ent] === List,
			(* do something with style info - e.g., thickness *)
			Null,
			writegroup[stream,40,.01,41,.01];
		];
		Scan[writevertex[stream,#,32]&,l[[1]]];
		writegroup[stream,0,"SEQEND"];
	]

entity[stream_OutputStream,ent:(p_Point | {st___,p_Point})] :=
	(writegroup[stream,
			0,"POINT",
			8,0];
	If[Head[ent] === List,
		(* do something with style info - e.g., pointsize. *)
		Null
	];
	writecoord[stream,p[[1]],{1}];)

endoffile[stream_OutputStream] :=
	writegroup[stream,0,"EOF"]

writevertex[stream_OutputStream,pts_,flag_] :=
	(writegroup[stream,0,"VERTEX",8,0,42,0,70,flag];
	writecoord[stream,pts,{1}])

writecoord[stream_OutputStream,pts_List,{num_Integer}] :=
	MapIndexed[writegroup[stream,First[#2] * 10 + num - 1,#1]&,
		pts]

writegroup[stream_,groups___] :=
	Apply[writegroup[stream,##]&,Partition[{groups},2],{1}]/;
		Length[{groups}] > 2

writegroup[stream_OutputStream,code_Integer,it_String] :=
	WriteString[stream,rightjustifynum[code],cr,
		it,cr]

writegroup[stream_OutputStream,code_Integer,it_] :=
	WriteString[stream,rightjustifynum[code],cr,
		ToString[CForm[it]],cr]

rightjustifynum[int_Integer?(#<10&)] :=
	StringJoin["  ",ToString[int]]

rightjustifynum[int_Integer?(#<100&)] :=
	StringJoin[" ",ToString[int]]

rightjustifynum[int_Integer?(#<1000)&] :=
	ToString[int]

End[]

EndPackage[]

(* :Examples:

(* A surface. *)

gr = Plot3D[BesselJ[0,Sqrt[x^2 + y^2]],{x,-6,6},{y,-6,6},
	PlotPoints->20];
	
gr = Graphics3D[gr];

WriteDXF["bessel.dxf",gr]

(* Some of the shapes that can be transferred. *)

gr2 = Graphics3D[{
	Cuboid[{0,0,0}],Polygon[{{0,0,1},{1/2,0,2},{1/2,1,2},
		{0,1,1}}], Polygon[{{0,0,0},{-1,0,-1},{-1,1,1/2},
		{-2,-2,-2},{-1,-3,0}}], Line[{{1,1,1},{2,1,1},
		{2,2,2},{1,2,2},{1,2,3},{3,3,3}}],
		Point[{.5,.5,.5}]}];

WriteDXF["misc.dxf",gr2]

*)
