Here I present a solution. First I will show how to use the function that generates the wire frame, then I will proceed to explain in detail the rest of the functions that compose the algorithm.
wireFrame
wireFrame[g_] := Module[{figInfo, opt, pts},
{figInfo, opt} = G3ToG2Info[g];
pts = getHiddenLines[figInfo];
Graphics[Map[setPoints[#] &, getFrame[figInfo, pts]], opt]
]
The input of this function is a Graphics3D object preferably with no axes.
fig = ListPlot3D[
{{0, -1, 0}, {0, 1, 0}, {-1, 0, 1}, {1, 0, 1}, {-1, 1, 1}},
Mesh -> {10, 10},
Boxed -> False,
Axes -> False,
ViewPoint -> {2, -2, 1},
ViewVertical -> {0, 0, 1},
MeshStyle -> Directive[RGBColor[0, 0.5, 0, 0.5]],
BoundaryStyle -> Directive[RGBColor[1, 0.5, 0, 0.5]]
]
Now we apply the function wireFrame.
wireFrame[fig]
As you can see wireFrame obtained most of the lines and its colors. There is a green line that was not included in the wireframe. This is most likely due to my threshold settings.
Before I proceed to explain the details of the functions G3ToG2Info, getHiddenLines, getFrame and setPoints I will show you why wire frames with hidden line removal can be useful.
The image shown above is a screenshot of a pdf file generated by using the technique described in rasters in 3D graphics combined with the wire frame generated here. This can be advantageous in various ways. There is no need to keep the information for the triangles to show a colorful surface. Instead we show a raster image of the surface. All of the lines are very smooth, with the exception of the boundaries of the raster plot not covered by lines. We also have a reduction of file size. In this case the pdf file size reduced from 1.9mb to 78kb using the combination of the raster plot and the wire frame. It takes less time to display in the pdf viewer and the image quality is great.
Mathematica does a pretty good job at exporting 3D images to pdf files. When we import the pdf files we obtain a Graphics object composed of line segments and triangles. In some cases this objects overlap and thus we have hidden lines. To make a wire frame model with no surfaces we first need to remove this overlap and then remove the polygons. I will start by describing how to obtain the information from a Graphics3D image.
G3ToG2Info
getPoints[obj_] := Switch[Head[obj],
Polygon, obj[[1]],
JoinedCurve, obj[[2]][[1]],
RGBColor, {Table[obj[[i]], {i, 1, 3}]}
];
setPoints[obj_] := Switch[Length@obj,
3, Polygon[obj],
2, Line[obj],
1, RGBColor[obj[[1]]]
];
G3ToG2Info[g_] := Module[{obj, opt},
obj = ImportString[ExportString[g, "PDF", Background -> None], "PDF"][[1]];
opt = Options[obj];
obj = Flatten[First[obj /. Style[expr_, opts___] :> {opts, expr}], 2];
obj = Cases[obj, _Polygon | _JoinedCurve | _RGBColor, Infinity];
obj = Map[getPoints[#] &, obj];
{obj, opt}
]
This code is for Mathematica 8 in version 7 you would replace JoinedCurve in the function getPoints by Line. The function getPoints assumes that you are giving a primitive Graphics object. It will see what type of object it recieves and then extract the information it needs from it. If it is a polygon it gets a list of 3 points, for a line it obtains a list of 2 points and if it is a color then it gets a list of a single list containing 3 points. This has been done like this in order to maintain consistency with the lists.
The function setPoints does the reverse of getPoints. You input a list of points and it will determine if it should return a polygon, a line or a color.
To obtain a list of triangles, lines and colors we use G3ToG2Info. This function will use
ExportString and ImportString to obtain a Graphics object from the Graphics3D version. This info is store in obj. There is some clean up that we need to perform, first we get the options of the obj. This part is necessary because it may contain the PlotRange of the image. Then we obtain all the Polygon, JoinedCurve and RGBColor objects as described in obtaining graphics primitives and directives. Finally we apply the function getPoints on all of these objects to get a list of triangles, lines and colors. This part covers the line {figInfo, opt} = G3ToG2Info[g].
getHiddenLines
We want to be able to know what part of a line will not be displayed. To do this we need to know point of intersection between two line segments. The algorithm I'm using to find the intersection can be found here.
lineInt[L_, M_, EPS_: 10^-6] := Module[
{x21, y21, x43, y43, x13, y13, numL, numM, den},
{x21, y21} = L[[2]] - L[[1]];
{x43, y43} = M[[2]] - M[[1]];
{x13, y13} = L[[1]] - M[[1]];
den = y43*x21 - x43*y21;
If[den*den < EPS, Return[-Infinity]];
numL = (x43*y13 - y43*x13)/den;
numM = (x21*y13 - y21*x13)/den;
If[numM < 0 || numM > 1, Return[-Infinity], Return[numL]];
]
lineInt assumes that the line L and M do not coincide. It will return -Infinity if the lines are parallel or if the line containing the segment L does not cross the line segment M. If the line containing L intersects the line segment M then it returns a scalar. Suppose this scalar is u, then the point of intersection is L[[1]] + u (L[[2]]-L[[1]]). Notice that it is perfectly fine for u to be any real number. You can play with this manipulate function to test how lineInt works.
Manipulate[
Grid[{{
Graphics[{
Line[{p1, p2}, VertexColors -> {Red, Red}],
Line[{p3, p4}]
},
PlotRange -> 3, Axes -> True],
lineInt[{p1, p2}, {p3, p4}]
}}],
{{p1, {-1, 1}}, Locator, Appearance -> "L1"},
{{p2, {2, 1}}, Locator, Appearance -> "L2"},
{{p3, {1, -1}}, Locator, Appearance -> "M1"},
{{p4, {1, 2}}, Locator, Appearance -> "M2"}
]
Now that we know how to far we have to travel from L[[1]] to the line segment M we can find out what portion of a line segment lies within a triangle.
lineInTri[L_, T_] := Module[{res},
If[Length@DeleteDuplicates[Flatten[{T, L}, 1], SquaredEuclideanDistance[#1, #2] < 10^-6 &] == 3, Return[{}]];
res = Sort[Map[lineInt[L, #] &, {{T[[1]], T[[2]]}, {T[[2]], T[[3]]}, {T[[3]], T[[1]]} }]];
If[res[[3]] == Infinity || res == {-Infinity, -Infinity, -Infinity}, Return[{}]];
res = DeleteDuplicates[Cases[res, _Real | _Integer | _Rational], Chop[#1 - #2] == 0 &];
If[Length@res == 1, Return[{}]];
If[(Chop[res[[1]]] == 0 && res[[2]] > 1) || (Chop[res[[2]] - 1] == 0 && res[[1]] < 0), Return[{0, 1}]];
If[(Chop[res[[2]]] == 0 && res[[1]] < 0) || (Chop[res[[1]] - 1] == 0 && res[[2]] > 1), Return[{}]];
res = {Max[res[[1]], 0], Min[res[[2]], 1]};
If[res[[1]] > 1 || res[[1]] < 0 || res[[2]] > 1 || res[[2]] < 0, Return[{}], Return[res]];
]
This function returns the the portion of the line L that needs to be deleted. For instance, if it returns {.5, 1} this means that you will delete 50 percent of the line, starting from half the segment to the ending point of the segment. If L = {A, B} and the function returns {u, v} then this means that the line segment {A+(B-A)u, A+(B-A)v} is the section of the line that its contained in the triangle T.
When implementing lineInTri you need to be careful that the line L is not one of the edges of T, if this is the case then the line does not lie inside the triangle. This is where rounding erros can be bad. When Mathematica exports the image sometimes a line lies on the edge of the triangle but these coordinates differ by some amount. It is up to us to decide how close the line lies on the edge, otherwise the function will see that the line lies almost completely inside the triangle. This is the reason of the first line in the function. To see if a line lies on an edge of a triangle we can list all the points of the triangle and the line, and delete all the duplicates. You need to specify what a duplicate is in this case. In the end, if we end up with a list of 3 points this means that a line lies on an edge. The next part is a little complicated. What we do is check for the intersection of the line L with each edge of the triangle T and store this the results in a list. Next we sort the list and find out what section, if any, of the line lies in the triangle. Try to make sense out of it by playing with this, some of the tests include checking if an endpoint of the line is a vertex of the triangle, if the line is completely inside the triangle, partly inside or completely outside.
Manipulate[
Grid[{{
Graphics[{
RGBColor[0, .5, 0, .5], Polygon[{p3, p4, p5}],
Line[{p1, p2}, VertexColors -> {Red, Red}]
},
PlotRange -> 3, Axes -> True],
lineInTri[{p1, p2}, {p3, p4, p5}]
}}],
{{p1, {-1, -2}}, Locator, Appearance -> "L1"},
{{p2, {0, 0}}, Locator, Appearance -> "L2"},
{{p3, {-2, -2}}, Locator, Appearance -> "T1"},
{{p4, {2, -2}}, Locator, Appearance -> "T2"},
{{p5, {-1, 1}}, Locator, Appearance -> "T3"}
]
lineInTri will be used to see what portion of the line will not be drawn. This line will most likely be covered by many triangles. For this reason, we need to keep a list of all the portions of each line that will not be drawn. These lists will not have an order. All we know is that this lists are one dimensional segments. Each one consisting of numbers in the [0,1] interval. I'm not aware of a union function for one dimensional segments so here is my implementation.
union[obj_] := Module[{p, tmp, dummy, newp, EPS = 10^-3},
p = Sort[obj];
tmp = p[[1]];
If[tmp[[1]] < EPS, tmp[[1]] = 0];
{dummy, newp} = Reap[
Do[
If[(p[[i, 1]] - tmp[[2]]) > EPS && (tmp[[2]] - tmp[[1]]) > EPS,
Sow[tmp]; tmp = p[[i]],
tmp[[2]] = Max[p[[i, 2]], tmp[[2]]]
];
, {i, 2, Length@p}
];
If[1 - tmp[[2]] < EPS, tmp[[2]] = 1];
If[(tmp[[2]] - tmp[[1]]) > EPS, Sow[tmp]];
];
If[Length@newp == 0, {}, newp[[1]]]
]
