Re: Transformation of 3D Objects to 2D Parallel-projection
- To: mathgroup at smc.vnet.net
- Subject: [mg108760] Re: Transformation of 3D Objects to 2D Parallel-projection
- From: Peter Breitfeld <phbrf at t-online.de>
- Date: Tue, 30 Mar 2010 05:03:05 -0500 (EST)
- References: <hopuvb$r5l$1@smc.vnet.net>
With the help of dh and Mark I'm now near to what I wanted. My
definitions are:
Definitions of the projection of some primitives:
Clear[SBProj]
SBProj[{x_?NumericQ, y_?NumericQ, z_?NumericQ}] :={y - x/2, z - x/2};
SBProj[ll_List] := SBProj /@ ll;
SBProj[Point[pts_]] := Point[SBProj[pts]];
SBProj[Line[x_]] := Line[SBProj[x]];
SBProj[Arrow[x_]] := Arrow[SBProj[x]];
SBProj[Polygon[x_, opts___]] := Polygon[SBProj[x], opts];
SBProj[x_] := x;
Transforming a 3D to a 2D graphic:
Clear[SBGraph];
SBRule = {
Point[x_] :> SBProj[Point[x]],
Line[x_] :> SBProj[Line[x]],
Arrow[x_] :> SBProj[Arrow[x]],
Polygon[x_, opts___] :> SBProj[Polygon[x, opts]]};
SBGraph[gr_] :=
Module[{pr = gr[[1]]},
If[Head[pr] === GraphicsComplex,
pr = pr //. GraphicsComplex[x_, y__] :> Normal[GraphicsComplex[x, y]]];
pr = DeleteCases[pr, Rule[VertexNormals, _], Infinity];
pr /. SBRule]
I think I had to Delete the VertexNormals options, because 2D-Polynoms
don't like this option
My routine to show the graphic:
Clear[SBZeichne]
Options[SBZeichne] = Options[Graphics];
SetOptions[SBZeichne, Axes -> True, AspectRatio -> Automatic];
SBZeichne[
grSB_List, {xmin_, xmax_, dx_: 2}, {ymin_, ymax_, dy_: 1}, {zmin_,
zmax_, dz_: 1}, dd_: 0.6, opt : OptionsPattern[]] :=
Module[{t, xSc, xLL, ySc, yLL, zSc, zLL, optA},
optA = OptionValue[Axes];
xSc = {}; xLL = {};
ySc = {}; yLL = {};
zSc = {}; zLL = {};
If[optA == True,
xSc = Table[{Line[{t = SBProj[{i, 0, 0}], t + {-0.07, 0}}],
Text[Style[ToString[i], FontSize -> 9], t, {-2, 0.5}]}, {i,
Ceiling[xmin], Floor[xmax], dx}];
xSc = DeleteCases[xSc, Text[_, {0, 0}, __], \[Infinity]];
xLL = Arrow[{SBProj[{xmin, 0, 0}], SBProj[{xmax + 2 dd, 0, 0}]}];
ySc = Table[{Line[{{i, 0}, {i, 0.07}}],
Text[Style[ToString[i], FontSize -> 9], {i, 0}, {0, 1.2}]}, {i,
Ceiling[ymin], Floor[ymax], dy}];
ySc = DeleteCases[ySc, Text[_, {0, 0}, __], \[Infinity]];
yLL = Arrow[{{ymin, 0}, {ymax + dd, 0}}];
zSc = Table[{Line[{{0, i}, {-0.07, i}}],
Text[Style[ToString[i], FontSize -> 9], {0, i}, {-2, 0}]}, {i,
Ceiling[zmin], Floor[zmax], dz}];
zSc = DeleteCases[zSc, Text[_, {0, 0}, __]];
zSc = DeleteCases[zSc, Text[_, {0, 0}, __], \[Infinity]];
zLL = Arrow[{{0, zmin}, {0, zmax + dd}}];
];
Show[Graphics[{grSB, xLL, xSc, yLL, ySc, zLL, zSc}], Axes -> False,
PlotRange -> {{Min[ymin, -(xmax + 2 dd)/2.],
Max[ymax + dd, -xmin/2.]}, {Min[zmin, -(xmax + 2 dd)/2.],
Max[zmax + dd, -xmin/2]}}, Flatten[{opt, Options[SBPlot]}]]
]
This works fine for all examples which aren't GraphicsComplex, e.g.:
This works fine, including Thickness and Color:
test = Graphics3D[{Thick, Blue,
Line[{{{0, 0, 0}, {1, 1, 1}}, {{1, 0, 0}, {0, 0, 1}}, {{0, 1,
0}, {1, 0, 1}}, {{0, 0, 1}, {1, 1, 0}}}]}];
SBZeichne[SBGraph[test], {0, 1, 1}, {0, 1}, {0, 1}, 0.2]
This one too:
p = ParametricPlot3D[{Cos[t], Sin[t], t/(2 \[Pi])}, {t, 0, 8 \[Pi]},
PlotStyle -> {Blue, Thickness[0.02]}];
SBZeichne[SBGraph[p], {0, 1}, {0, 2}, {0, 4.1}]
But, this one (a GraphicsComplex) shows the plane, but only in black
with some white Mesh-lines. I hoped to be able to preserve the Mesh and
(blue) coloring from the original Graphics3D[GraphicsComplex] when
displaying it with SBZeichne:
gr = Plot3D[x + y, {x, -2, 2}, {y, -2, 2}];
SBZeichne[SBGraph[gr], {0, 5}, {0, 5}, {0, 5}]
What am I missing or doing wrong?
Thanks for your help
Peter
Mark McClure wrote:
> On Sun, Mar 28, 2010 at 7:55 AM, Peter Breitfeld <phbrf at t-online.de> wrote:
>> I wrote some routines to map 3D-coordinates to 2D using the
>> transformation
>> proj[{x_,y_,z_}]:={y-x/2,z-x/2}
>>
>> But this doesn't work for all kind of 3D-objects.
>> ...
>> So my question: Is it possible to have routines, which will work on any
>> kind of 3D-primitives including Cuboid[], Cylinder[] etc, which will
>> preserve Thickness, Color etc
>
> I'd suggest that you use patterns to write a different version of proj
> for each primitive that you want to work with. Thus, you might have
> some lines like the following.
>
> proj[{x_?NumericQ, y_?NumericQ, z_?NumericQ}] := {y - x/2, z - x/2};
> proj[list_List] := proj /@ list;
> proj[Point[pts_]] := Point[proj[pts]];
> proj[Line[x_]] := Line[proj[x]];
> proj[Arrow[x_]] := Arrow[proj[x]];
> proj[Polygon[x_, pOpts___]] := Polygon[proj[x], pOpts];
>
> To deal with something like Cylinder or Cuboid, you'll need to
> translate it two an appropriate 2D primitive to represent the
> projection. You might deal with a Cuboid like so
>
> Needs["ComputationalGeometry`"];
> proj[Cuboid[{xmin_, ymin_, zmin_}, {xmax_, ymax_, zmax_}]] :=
> Module[{},
> vv = Tuples[{{xmin, xmax}, {ymin, ymax}, {zmin, zmax}}];
> projected = proj[vv];
> Polygon[projected[[ConvexHull[projected]]]]];
> proj[Cuboid[{xmin_, ymin_, zmin_}]] := proj[Cuboid[{xmin, ymin, zmin},
> {xmin + 1, ymin + 1, zmin + 1}]];
>
> At the end of it all, include
>
> proj[x_] := x;
>
> to ignore everything else, such as Graphics directives. Here's an
> example that might or might not illustrate the idea.
>
> pic3D = Graphics3D[primitives = {
> {Thick, Line[{{{0, 0, 0}, {1, 1, 1}}, {{1, 0, 0}, {0, 1, 1}},
> {{0, 1, 0}, {1, 0, 1}}, {{0, 0, 1}, {1, 1, 0}}}]},
> {Opacity[0.5], Cuboid[{1/4, 1/4, 1/4}, {3/4, 3/4, 3/4}]}}];
> pic2D = Graphics[proj[primitives]];
> GraphicsRow[{pic3D, pic2D}]
>
> Dealing with GraphicsComplex is easier in some ways. Since it has the form
>
> GraphicsComplex[points, primitives]
>
> you simply map proj onto the points. But you'll need to extract
> Cuboids, Cylinders, Spheres and such (perhaps using Cases) to deal
> with them separately.
>
> Hope that helps,
> Mark McClure
>
--
_________________________________________________________________
Peter Breitfeld, Bad Saulgau, Germany -- http://www.pBreitfeld.de