       Re: Coordinates from Graphics3D images

• To: mathgroup at smc.vnet.net
• Subject: [mg117815] Re: Coordinates from Graphics3D images
• From: Heike Gramberg <heike.gramberg at gmail.com>
• Date: Thu, 31 Mar 2011 06:04:47 -0500 (EST)

```The Texture just adds a layer of paint, i.e. it doesn't change the shape of you object.
You mention that you want to export it to stl. I'm not familiar with the format but
according to the Mathematica documentation it doesn't save colour, so texture
wouldn't be saved either.

Another approach to get something that looks like the first picture in your example
is make a ListPlot3D of the grey level data and then transform the coordinates in
your plot to cartesian coordinates using replacement rules.

What I mean is something like

(*importing data*)data = N[Rescale[Import["ldem_4.png", "Data"]]];
data = Join[data, data[[All, {1}]],
2];(*for periodicity purposes*)(*sector of interest*)
thetaRange = \
{30 Degree, 90 Degree};
phiRange = {25 Degree, 60 Degree};
sector = Take[data,
Round[Rescale[thetaRange, {0., Pi}, {1, Dimensions[data][]}]],
Round[Rescale[phiRange, {0., 2 Pi}, {1, Dimensions[data][]}]]];

(*for transforming to cartesian coordinates*)
dr = 0.1;(*max elevation relative to radius of the moon*)

pt[{ph_, th_, e_}] := {Sin[th] Cos[ph], Sin[th] Sin[ph], Cos[th]} (1 + dre);
rotMat = RotationMatrix[{pt[{Total[phiRange]/2, Total[thetaRange]/2,
1}], {0, 0, 1}}]; (* rotating the center of the sector *)

(*plot in spherical coordinates*)

plot = ListPlot3D[sector, DataRange -> {phiRange, thetaRange},
Mesh -> None, NormalsFunction -> None];

(*transformation to cartesian coordinates*)

sphPlot =
Release[plot /.
GraphicsComplex[a_, c__] ->
GraphicsComplex[Hold[rotMat.pt[#] & /@ a], Hold[c]]];
Show[sphPlot, PlotRange -> All]

Heike

On 30 Mar 2011, at 11:10, finkh wrote:

> I would like to extract the surface and the accompanying texture from
>
> moon = SphericalPlot3D[1, {u, 0, Pi}, {v, 0, 2 Pi}, Mesh -> None,
>  TextureCoordinateFunction -> ({#5, 1 - #4} &),
>  PlotStyle ->
>   Directive[Specularity[White, 10],
>    Texture[Import[
>      "http://finkh.files.wordpress.com/2011/03/ldem_4.png";]]],
>  Lighting -> {"Ambient", White}, Axes -> False, Boxed -> False,
>  RotationAction -> "Clip"]
>
> This is a map of the moon with elevation data represented by a
> grayscale texture taken from the Planetary Data System.  When I
> extract the polygons from the object the texture does not travel with
> the polygons.  How would I select a portion of the sphere while
> preserving the shape and the texture.
>
> Then reorient so the center of the selection is up, convert to
> cartesian, listplot3d and export as stl for the rapid prototyper.
>
> Here is what I am doing:  http://finkh.wordpress.com/2011/02/01/the-south-pole-of-the-moon-shackleton-crater/
>

```

• Prev by Date: Re: Fit Gaussian function to histogram
• Previous by thread: Re: Coordinates from Graphics3D images