Re: 3D contour through a point[2]
- To: mathgroup at smc.vnet.net
- Subject: [mg34095] Re: 3D contour through a point[2]
- From: "Allan Hayes" <hay at haystack.demon.co.uk>
- Date: Thu, 2 May 2002 03:49:44 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
Bram Platel has aked if the technique used for 2D lines in my earlier
posting can be used on surfaces.
I give the analogous technique below, but first I should correct an error in
the earlier posting:
g3=DeleteCases[g2,ln_Line/;Min[(#.#&[{.6,.2}-#])&/@ln[[1]]]<0.1,
Infinity];
should be
g3=DeleteCases[g2,ln_Line/;Min[(#.#&[{.6,.2}-#])&/@ln[[1]]]>0.1,
Infinity];
Now for surfaces.
<<Graphics`ContourPlot3D`
Similar technique to 2D except for the grouping stage, see below.
Suppose we want the contour sheet of x y z that goes through
{0.53,-0.75,-0.25}.
First get
g=ContourPlot3D[x y z,
{x,-1,1}, {y,-1,1}, {z,-1,1},
Contours -> {0.53*-0.75*-0.25}]
Now we need to group the polygons into those on the same sheet.
Wrap each polygon in S (just a wrapper for separation)
sg2=S/@g[[1]];
Now collect into sheets
g3=g2//.{a___, b:S[___,Polygon[{___,x_,___}],___],c___,
d:S[___,Polygon[{___,x_,___}],___],e___}:>
{a,c,e,Join[b,d]};
Check
Show[Graphics3D[List@@@g3]
Delete the sheets that don't go close enough to {0.53,-0.75,-0.25}
g4=
DeleteCases[g3,s_S/;Min[(#.#&[{0.53,-0.75,-0.25}-#])&/@Level[s,{-2}]]>0.1
,Infinity];
Check
Show[Graphics3D[{List @@@ g4, PointSize[.05],
Point[{0.53, -0.75, -0.25}]}]]
--
Allan
---------------------
Allan Hayes
Mathematica Training and Consulting
Leicester UK
www.haystack.demon.co.uk
hay at haystack.demon.co.uk
Voice: +44 (0)116 271 4198
Fax: +44 (0)870 164 0565