Problems updating Graphics3D Polygons

chuck009

unread,

Jun 13, 2007, 7:40:43 AM6/13/07

to

Hello guys. Can you help me write a function which takes a Graphics3D object and multiplies the z-coordinate of each point of all the polygons by a ratio. This is what I have so far but it's not working:

In[473]:=
ExpandZ[g_,ratio_]:=
g/.Polygon[pts_]:>Polygon[{#[[1]],#[[2]],#[[3]]*ratio}& /@pts];

When I test it with this simple Graphics3D object:

gobject=Graphics3D[{Polygon[{{0.,0.5,1.28},{0.,0.,1.},{0.5,0.,1.28},{0.5,
0.5,1.64}}],Polygon[{{
0.5,0.5,1.64},{0.5,0.,1.28},{1.,0.,2.71},{1.,0.5,3.49}}]}];

It doesn't do anything:

g2=Expand[gobject,2]
InputForm[g2]

Out[475]=
⁃Graphics3D⁃

Out[476]//InputForm=
Graphics3D[{Polygon[{{0., 0.5, 1.28}, {0., 0., 1.},
{0.5, 0., 1.28}, {0.5, 0.5, 1.64}}],
Polygon[{{0.5, 0.5, 1.64}, {0.5, 0., 1.28},
{1., 0., 2.71}, {1., 0.5, 3.49}}]}]

I'll keep working on it. Thanks!

Jens-Peer Kuska

unread,

Jun 14, 2007, 5:24:06 AM6/14/07

to

Hi,

this will prbably fail with Mathematica 6
but

ExpandZ[g_, ratio_] :=
g /. Polygon[pts_] :> Polygon[#*{1, 1, ratio} & /@ pts];

should do it in version 5.x

Regards
Jens

Jean-Marc Gulliet

unread,

Jun 14, 2007, 5:29:08 AM6/14/07

to

chuck009 wrote:
> Hello guys. Can you help me write a function which takes a Graphics3D object and multiplies the z-coordinate of each point of all the polygons by a ratio. This is what I have so far but it's not working:
>
> In[473]:=
> ExpandZ[g_,ratio_]:=
> g/.Polygon[pts_]:>Polygon[{#[[1]],#[[2]],#[[3]]*ratio}& /@pts];
>
> When I test it with this simple Graphics3D object:
>
> gobject=Graphics3D[{Polygon[{{0.,0.5,1.28},{0.,0.,1.},{0.5,0.,1.28},{0.5,
> 0.5,1.64}}],Polygon[{{
> 0.5,0.5,1.64},{0.5,0.,1.28},{1.,0.,2.71},{1.,0.5,3.49}}]}];
>
> It doesn't do anything:
>
> g2=Expand[gobject,2]

-----^^^^^^
Should have been *ExpandZ*

> InputForm[g2]
>
> Out[475]=
> ⁃Graphics3D⁃
>
> Out[476]//InputForm=
> Graphics3D[{Polygon[{{0., 0.5, 1.28}, {0., 0., 1.},
> {0.5, 0., 1.28}, {0.5, 0.5, 1.64}}],
> Polygon[{{0.5, 0.5, 1.64}, {0.5, 0., 1.28},
> {1., 0., 2.71}, {1., 0.5, 3.49}}]}]
>
> I'll keep working on it. Thanks!
>

Your code is fine. However, you have made a spelling mistake: you do not
want Expand bur *ExpandZ* (that is why it is useful to use a lowercase
letter at the beginning of the name of a user define function :-)

In[1]:= ExpandZ[g_, ratio_] := g /. Polygon[pts_] :>
Polygon[({#1[[1]], #1[[2]], #1[[3]]*ratio} & ) /@ pts];
gobject = Graphics3D[{Polygon[{{0., 0.5, 1.28}, {0., 0., 1.},

{0.5, 0., 1.28}, {0.5, 0.5, 1.64}}],
Polygon[{{0.5, 0.5, 1.64}, {0.5, 0., 1.28}, {1., 0., 2.71},

{1., 0.5, 3.49}}]}];
g2 = ExpandZ[gobject, 2]
InputForm[g2]

Out[4]//InputForm=
Graphics3D[{Polygon[{{0., 0.5, 2.56}, {0., 0., 2.}, {0.5, 0., 2.56},
{0.5, 0.5, 3.28}}], Polygon[{{0.5, 0.5, 3.28}, {0.5, 0., 2.56},
{1., 0., 5.42}, {1., 0.5, 6.98}}]}]

Regards,
Jean-Marc

dh

unread,

Jun 14, 2007, 5:44:29 AM6/14/07

to

Hi,

your problem is a simple typo, your wrote Expand instead of ExpandZ.

Hope this helps, Daniel

DrMajorBob

unread,

Jun 14, 2007, 5:47:30 AM6/14/07

to

"In[473]:ExpandZ[g_,ratio_]:

g/.Polygon[pts_]:>Polygon[{#[[1]],#[[2]],#[[3]]*ratio}& /@pts];"

There are a couple of "=" signs missing; not sure what you're seeing at
your machine.

This works at mine:

Clear[expandZ]
expandZ[g_, ratio_] :=
g /. Polygon[pts_] :>
Polygon[{#[[1]], #[[2]], #[[3]]*ratio} & /@ pts];

But I prefer

Clear[expandZ]
expandZ[g_, ratio_] :=
g /. Polygon[pts_] :>
Polygon[pts.{{1, 0, 0}, {0, 1, 0}, {0, 0, ratio}}];

Bobby

On Wed, 13 Jun 2007 06:28:25 -0500, chuck009 <dmil...@comcast.com> wrote:

> Hello guys. Can you help me write a function which takes a Graphics3D
> object and multiplies the z-coordinate of each point of all the polygons
> by a ratio. This is what I have so far but it's not working:
>

> In[473]:ExpandZ[g_,ratio_]:

> g/.Polygon[pts_]:>Polygon[{#[[1]],#[[2]],#[[3]]*ratio}& /@pts];
>
> When I test it with this simple Graphics3D object:
>
> gobject=Graphics3D[{Polygon[{{0.,0.5,1.28},{0.,0.,1.},{0.5,0.,1.28},{0.5,
> 0.5,1.64}}],Polygon[{{
> 0.5,0.5,1.64},{0.5,0.,1.28},{1.,0.,2.71},{1.,0.5,3.49}}]}];
>
> It doesn't do anything:
>
> g2=Expand[gobject,2]
> InputForm[g2]
>

> Out[475]â�ƒGraphics3Dâ�ƒ
>
> Out[476]//InputFormGraphics3D[{Polygon[{{0., 0.5, 1.28}, {0., 0., 1.},

> {0.5, 0., 1.28}, {0.5, 0.5, 1.64}}],
> Polygon[{{0.5, 0.5, 1.64}, {0.5, 0., 1.28},
> {1., 0., 2.71}, {1., 0.5, 3.49}}]}]
>
> I'll keep working on it. Thanks!
>
>

--
DrMaj...@bigfoot.com

chuck009

unread,

Jun 14, 2007, 5:55:37 AM6/14/07

to

Hey guys. I did make progress with this by coding:

UpdatePoints[factor_][p_] := Block[{x, y, z},
{x, y, z} = p;
z *= factor;
Return[{x, y, z}];
];

ScaleZ[graphics_, factor_] := Module[{g2}, g2 = graphics /.Polygon[pts_] :> Polygon[UpdatePoints[factor] /@ pts];
Return[g2];
];

Perhaps though someone can suggest a more elegant "one-liner"

Jean-Marc Gulliet

unread,

Jun 15, 2007, 4:27:29 AM6/15/07

to

*Return* is useless here.

In[1]:= gobject = Graphics3D[{Polygon[{{0., 0.5, 1.28}, {0., 0., 1.},

{0.5, 0., 1.28}, {0.5, 0.5, 1.64}}],
Polygon[{{0.5, 0.5, 1.64}, {0.5, 0., 1.28}, {1., 0., 2.71},

{1., 0.5, 3.49}}]}];

UpdatePoints[factor_][p_] := Block[{x, y, z},

{x, y, z} = p; z *= factor; {x, y, z}]

ScaleZ[graphics_, factor_] := Module[{g2},

g2 = graphics /. Polygon[pts_] :> Polygon[UpdatePoints[factor] /@
pts]; g2]
g2 = ScaleZ[gobject, 2]
InputForm[g2]

Out[5]//InputForm=

Graphics3D[{Polygon[{{0., 0.5, 2.56}, {0., 0., 2.}, {0.5, 0., 2.56},
{0.5, 0.5, 3.28}}], Polygon[{{0.5, 0.5, 3.28}, {0.5, 0., 2.56},
{1., 0., 5.42}, {1., 0.5, 6.98}}]}]

What do you like in your original function *ExpandZ* ?

In[6]:= ExpandZ[g_, ratio_] := g /. Polygon[pts_] :>

Polygon[({#1[[1]], #1[[2]], #1[[3]]*ratio} & ) /@ pts]

g2 = ExpandZ[gobject, 2]
InputForm[g2]

Out[8]//InputForm=

chuck009

unread,

Jun 15, 2007, 4:52:13 AM6/15/07

to

Thanks. Jean-Marc noticed in my original post that I just didn't call the function correctly. I like the code you used below, the pts.{{1,0,0},{0,1,0},{0,0,ratio}}. I see what it does just not sure of the construct. I'll figure it out though. Thanks!

> "In[473]:ExpandZ[g_,ratio_]:
> g/.Polygon[pts_]:>Polygon[{#[[1]],#[[2]],#[[3]]*ratio}
> & /@pts];"
>
> There are a couple of "=" signs missing; not sure
> what you're seeing at
> your machine.
>
> This works at mine:
>
> Clear[expandZ]

> expandZ[g_, ratio_] :=
> g /. Polygon[pts_] :>

> Polygon[{#[[1]], #[[2]], #[[3]]*ratio} & /@
> & /@ pts];
>
> But I prefer
>
> Clear[expandZ]

> expandZ[g_, ratio_] :=
> g /. Polygon[pts_] :>

> Polygon[pts.{{1, 0, 0}, {0, 1, 0}, {0, 0,

> 0, 0, ratio}}];
>

DrMajorBob

unread,

Jun 15, 2007, 5:04:31 AM6/15/07

to

A solution doesn't HAVE to be this flexible, but... why the heck not?

Clear[scaleZ, array, threeD]
array[dims_List] = ArrayQ[#] && Dimensions[#] == dims &;
threeD[m_?(array[{3, 3}])] := m
threeD[m_?(array[{3}])] := DiagonalMatrix@m
threeD[f_?NumericQ] := DiagonalMatrix@{1, 1, f}
scaleZ[graphics_, m_] :=
graphics /. Polygon[pts_] :> Polygon[pts.threeD[m]]

Try it out:

gobject =
Graphics3D[{Polygon[{{0., 0.5, 1.28}, {0., 0., 1.}, {0.5, 0.,
1.28}, {0.5, 0.5, 1.64}}],
Polygon[{{0.5, 0.5, 1.64}, {0.5, 0., 1.28}, {1., 0., 2.71}, {1.,
0.5, 3.49}}]}]

scaleZ[gobject, 1/3]

scaleZ[gobject, {1, 2, 1}]

scaleZ[gobject, RandomReal[{1/2, 3/2}, {3, 3}]]

Bobby

On Thu, 14 Jun 2007 04:33:03 -0500, chuck009 <dmil...@comcast.com> wrot=
e:

> Hey guys. I did make progress with this by coding:
>
> UpdatePoints[factor_][p_] := Block[{x, y, z},
> {x, y, z} = p;
> z *= factor;
> Return[{x, y, z}];
> ];
>

> ScaleZ[graphics_, factor_] := Module[{g2}, g2 = graphics /.Polygon=
[pts_] =

> :> Polygon[UpdatePoints[factor] /@ pts];
> Return[g2];
> ];
>
> Perhaps though someone can suggest a more elegant "one-liner"
>
>

-- =

DrMaj...@bigfoot.com

DrMajorBob

unread,

Jun 16, 2007, 3:29:44 AM6/16/07

to

I'm multiplying the polygon list by a 3x3 matrix.

(I posted this before, but just in case...)

array[dims] checks the dimensions of its argument, threeD changes a scalar
or 3-vector into a 3x3, and scaleZ multiplies the polygon list by that
matrix. The multiplication is pts.matrix; pts is n x 3 and matrix is 3x3,
so the result is n x 3 again, still suitable as the argument to Polygon.

(This could be modified to work for 2D plots as well, but I haven't.)

Clear[scale, array, threeD]

array[dims_List] = ArrayQ[#] && Dimensions[#] == dims &;
threeD[m_?(array[{3, 3}])] := m
threeD[m_?(array[{3}])] := DiagonalMatrix@m
threeD[f_?NumericQ] := DiagonalMatrix@{1, 1, f}

scale[graphics_, m_] :=

graphics /. Polygon[pts_] :> Polygon[pts.threeD[m]]

gobject =

Graphics3D[{Polygon[{{0., 0.5, 1.28}, {0., 0., 1.}, {0.5, 0.,
1.28}, {0.5, 0.5, 1.64}}],
Polygon[{{0.5, 0.5, 1.64}, {0.5, 0., 1.28}, {1., 0., 2.71}, {1.,
0.5, 3.49}}]}]

scale[gobject, 1/3]

scale[gobject, {1, 2, 1}]

scale[gobject, RandomReal[{1/2, 3/2}, {3, 3}]]

Bobby

--
DrMaj...@bigfoot.com

DrMajorBob

unread,

Jun 16, 2007, 3:30:45 AM6/16/07

to

Here's a version that works for 2D and 3D (and other, if they existed)
polygons:

Clear[scalePts, scaleGraph]
scale[pts_, m_] := Module[
{d = Dimensions[pts][[2]]},
Which[
ArrayQ[m] && Dimensions[m] == {d, d}, pts.m,
VectorQ[m] && Length[m] == d, pts.DiagonalMatrix[m],
NumericQ[m], pts.DiagonalMatrix[ConstantArray[1, d - 1]~Join~{m}],
True, Print["error"]; pts
]
]
scaleGraph[graphics_, m_] :=
graphics /. Polygon[pts_] :> Polygon[scale[pts, m]]

g = Graphics3D[{Polygon[{{0., 0.5, 1.28}, {0., 0., 1.}, {0.5, 0.,

1.28}, {0.5, 0.5, 1.64}}],
Polygon[{{0.5, 0.5, 1.64}, {0.5, 0., 1.28}, {1., 0., 2.71}, {1.,

0.5, 3.49}}]}];
scaleGraph[g, 1/3]
scaleGraph[g, {1, 2, 1}]
scaleGraph[g, RandomReal[{1/2, 3/2}, {3, 3}]]

g = Graphics[Polygon[{{1, 0}, {0, Sqrt[3]}, {-1, 0}}]];
scaleGraph[g, 1/3]
scaleGraph[g, {2, 3}]
scaleGraph[g, RandomReal[{1/2, 3/2}, {2, 2}]]

Bobby

On Fri, 15 Jun 2007 11:59:34 -0500, DrMajorBob <drmaj...@bigfoot.com>
wrote:

chuck009

unread,

Jun 16, 2007, 3:36:59 AM6/16/07

to

That's tough for me to follow. Looks like polymorphism. Was not aware I could do that in Mathematica. Nice to read and study other peoples code here. That helps me get better. The Mathematica syntax is the tough part for me but I'm getting better by hanging out here :)

> A solution doesn't HAVE to be this flexible, but...
> why the heck not?
>

> Clear[scaleZ, array, threeD]

> array[dims_List] = ArrayQ[#] && Dimensions[#] == dims
> &;
> threeD[m_?(array[{3, 3}])] := m
> threeD[m_?(array[{3}])] := DiagonalMatrix@m
> threeD[f_?NumericQ] := DiagonalMatrix@{1, 1, f}

> scaleZ[graphics_, m_] :=

> graphics /. Polygon[pts_] :> Polygon[pts.threeD[m]]
>

> Try it out:
>