Thanks for any suggestions
Hugh Goyder
pp = {{{0, 0, 0}, {5, 0, 0},
{10, 0, 0}, {14, 0, 0},
{19, 0, 0}, {24, 0, 0},
{29, 0, 0}, {33, 0, 0},
{38, 0, 0}, {43, 0, 0},
{48, 0, 0}},
{{0, 53, 3}, {5, 53, 3},
{10, 53, 3}, {14, 53,
3}, {19, 53, 3},
{24, 53, 3}, {29, 53,
3}, {33, 53, 3},
{38, 53, 3}, {43, 53,
3}, {48, 53, 3}},
{{0, 107, 18}, {5, 107,
19}, {10, 107, 19},
{14, 107, 19},
{19, 107, 19},
{24, 107, 18},
{29, 107, 18},
{33, 107, 18},
{38, 107, 18},
{43, 107, 18},
{48, 107, 18}},
{{0, 160, 81}, {5, 160,
81}, {10, 160, 81},
{15, 160, 80},
{20, 160, 80},
{25, 160, 80},
{30, 160, 80},
{35, 160, 79},
{40, 160, 79},
{45, 160, 79},
{50, 160, 79}},
{{0, 213, 142},
{6, 213, 142},
{12, 213, 141},
{18, 213, 141},
{25, 213, 140},
{31, 213, 140},
{37, 213, 140},
{43, 213, 139},
{49, 213, 139},
{56, 213, 138},
{62, 213, 138}},
{{0, 267, 93}, {9, 267,
93}, {18, 267, 93},
{27, 267, 93},
{36, 267, 93},
{45, 267, 93},
{54, 267, 92},
{63, 267, 92},
{72, 267, 91},
{82, 267, 91},
{91, 267, 90}},
{{0, 320, 60}, {13, 320,
60}, {26, 320, 60},
{40, 320, 60},
{53, 320, 59},
{66, 320, 59},
{79, 320, 58},
{92, 320, 58},
{105, 320, 58},
{118, 320, 58},
{132, 320, 57}},
{{0, 373, 40}, {18, 373,
40}, {36, 373, 40},
{54, 373, 40},
{72, 373, 40},
{90, 373, 40},
{108, 373, 40},
{126, 373, 40},
{144, 373, 40},
{162, 373, 40},
{180, 373, 40}},
{{0, 427, 29}, {23, 427,
29}, {47, 427, 29},
{70, 427, 29},
{93, 427, 29},
{116, 427, 29},
{140, 427, 29},
{163, 427, 28},
{186, 427, 28},
{210, 427, 28},
{233, 427, 28}},
{{0, 480, 22}, {29, 480,
22}, {58, 480, 22},
{87, 480, 22},
{116, 480, 22},
{145, 480, 22},
{174, 480, 22},
{203, 480, 22},
{232, 480, 22},
{260, 480, 22},
{289, 480, 22}},
{{0, 533, 17}, {35, 533,
17}, {70, 533, 17},
{104, 533, 17},
{139, 533, 17},
{174, 533, 17},
{209, 533, 17},
{244, 533, 17},
{278, 533, 17},
{313, 533, 17},
{348, 533, 17}}};
g1 = Graphics3D[{Point[Flatten[pp, 1]]},
PlotRange -> All]
g2 = ListPlot3D[Flatten[pp, 1]]
Show[g1, g2]
This is a pretty nasty way of doing it, but at least it works ...
Show[ListPlot3D[#, Mesh -> None] & /@ (Join @@ # & /@
Partition[pp, 2, 1]), PlotRange -> All]
viz:
ppf = Flatten[pp, 1]
gc = GraphicsComplex[ppf, Table[Sphere[i, 5], {i, Length[ppf]}]];
g1 = Graphics3D[{Orange, gc}]
g2 = ListPlot3D[ppf]
Show[g2, g1]
g3 = ListPlot3D[Flatten[pp, 1], InterpolationOrder -> 3]
Show[g3, g1]
WCC
On Tue, May 13, 2008 at 7:08 AM, Hugh Goyder
<h.g.d....@cranfield.ac.uk> wrote:
> Below I give a set of 3D points and attempt to plot them as a surface
> using ListPlot3D. I also plot the points directly using Graphics3D.
> The data fill a region that is approximately a trapezium except that
> one side is concave. ListPlot3D extrapolates the concave side out to
> the convex hull of the x -y coordinates thus giving a false impression
> of the surface. How can I make the plotting region conform to the data
> and exclude the extrapolation?
> pp = {{{0, 0, 0}, {5, 0, 0},
> {10, 0, 0}, {14, 0, 0},
:
:
> {348, 533, 17}}};
>
> g1 = Graphics3D[{Point[Flatten[pp, 1]]},
> PlotRange -> All]
>
> g2 = ListPlot3D[Flatten[pp, 1]]
>
> Show[g1, g2]
>
>
>
--
W. Craig Carter
I just noticed that you have a regular matrix of 3D points. What you
really need is not ListPlot3D, but a "ListParametricPlot3D", that AFAIK
does not exist.
So here's a very simple implementation:
listParametricPlot3D[points_, opt___?OptionQ] := Module[{xx, yy},
{yy, xx} = Take[Dimensions[points], 2];
Graphics3D[GraphicsComplex[Join @@ points,
Polygon[
Join @@
Table[{1 + i + xx j, 2 + i + xx j, 2 + i + xx (j + 1),
1 + i + xx (j + 1)}, {j, 0, yy - 2}, {i, 0, xx - 2}]
]], opt]
]
Fancy stuff like VertexNormals or interpolation is not handled.
listParametricPlot3D[pp] will create the plot you're looking for.
Here's another example:
listParametricPlot3D[
Table[{Cos[u] Cos[v], Cos[u] Sin[v], Sin[u]},
{u, -Pi/2, Pi/2, Pi/14}, {v, 0, 2 Pi, 2 Pi/28}],
Boxed -> False, SphericalRegion -> True
]