Re: i don't want intersection
- To: mathgroup at smc.vnet.net
- Subject: [mg28780] Re: i don't want intersection
- From: "Allan Hayes" <hay at haystack.demon.co.uk>
- Date: Sat, 12 May 2001 20:18:12 -0400 (EDT)
- References: <9di08i$kus@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Borut,
> I made a function which displays 3D contour lines onto Surface Graphics.
> It's pretty neat. There is a problem though. The contours "fit" so
perfecty
> onto the surface that they [are] a part of the surface - so half visible
> half hidden by the surface - they seem to intersect.
Two ways out:
1) draw the contour lines along the triangles that make up the polygons in
the Graphics3D object
2) lift the contour lines towards the view point.
The package code below uses 2).
If the code corrupts in transit please let me know and I'll try sending it
in another way.
--
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
(*: Title : ContourPlotOnSurface*)
(*: LAST CHANGE : 23 Feb 2000*)
(*: Author : Allan Hayes, hay at haystack.demon.co.uk*)
(*: Summary :
ContourPlotOnSurface has two functions : \n ParametricPlot3DContoured
and Plot3DContoured\n
These allow contour lines of functions to be drawn on 3D plots.\n There are
four special options :
ContourLift,
ContourStyleFunction
Linearized
Surface
Graphics3D[Graphics3DContoured[ ...]] gives a Graphics3D object.
*)
(*: Context : haypacks`Graphics`ContourPlotOnSurface `*)
(*: Package Version : 1.2*)
(*: Copyright : Copyright 1994,1996,1997,1998,2000, Allan Hayes.*)
(*: History :
Version 1.5,Feb 2000
Corrected fault in display of examples due to change from 2.2 to 3.0
Added option Linearized
Changed name, ContourColorFunction to ContourStyleFunction
Version 1.4, Nov 1998
Defined Plot3DContoured in terms of ParametricPlot3DContoured instead of
coding separately (may slow computation a bit but simplifies
code). Allowed for empty list of contour lines (caused by the contour values
being outside the height range).
Version 1.3,March 1997
Added contour lines of function f[s, t] on surface {x[s, t], y[s, t], z[s,
t]}
Version 1.2, Nov 1994 ContourLines3DInfo added
Version 1.1 May 1994.
Version 1.0 March 1994.
*)
(*: Warnings:
Show is extended to deal with the object that is returned by the
function PlotContoured.
Color directives given by two options, ContourStyles ContourStyleFunction.*)
(*: Keywords : Contour, Plot*)
(*: Mathematica Version : 3.0x or later*)
(*: Limitation: The Graphics3DContoured objects, ob, that are given by the
plotting functions in this package do not combine with other graphics
object, and do not respond to FullOptions and FullGraphics.
But Graphics3D[obj] gives the corresponding Graphics3D object.
*)
(*** BEGIN PACKAGE CONTEXT***)
BeginPackage[
"haypacks`Graphics`ContourPlotOnSurface`",
"Utilities`FilterOptions`"
];
Unprotect["`*"];
ClearAll["`*"];
(*** USAGE MESSAGES***)
ContourPlotOnSurfaceHelp::usage =
"ContourPlotOnSurface is a package with two functions,\n
Plot3DContoured,gives a Plot3D surface with contour lines of any function of
the variables added.\n
ParametricPlot3DContoured, gives a ParametricPlot3D surface with contour
lines of a function of the parameters added.\n
Extensive options allow variations to be made.\n
\nPlease see the separate entries for more information and examples.
";
ParametricPlot3DContoured::usage =
"ParametricPlot3DContoured[{x,y,z,w},{u,umin,umax},{v,vmin,vmax}, opts],for
expressions x,y,z,w in u,v, gives the contour lines of w on the surface
given by\n
ParametricPlot3D[{x,y,z},{u,umin,umax},{v,vmin,vmax}, opts].\n
ParametricPlot3DContoured[{x,y,z},{u,umin,umax},{v,vmin,vmax}, opts] gives
the same as ParametricPlot3D[{x,y,z,z},{u,umin,umax},{v,vmin,vmax}, opts].\n
The contours are controled by ContourPlot options and a new option,
ContourStyleFunction(settings by the latter for any type of directive
overide any settings by the former for the same type)\n
ContourLift sets the amount by which contours are moved towards the
viewpoint to avoid parts of them being hidden by the surface\n
Surface->Transparent gives a wire frame.\n
Linearized ->True give a better fit of contours to surface, more noticeable
when PlotPoints is set low, but the computation takes longer.\n
The options Mesh and MeshStyle control whether the polygon edges are shown
and their styles.\n\n
Options:\n
ParametricPlot3DContoured has the union of the options of ParametricPlot3D,
Plot3D and ContourPlot as options, together with four new options:
ContourLift, ContourStyleFunction, Surface and Linearized.\n\n\n
Examples:\n
Please enter ParametricPlot3DContouredExamples. Input cells will be made
below the entry cell.
";
Plot3DContoured::usage =
"Plot3DContoured[{z,w},{u,umin,umax},{v,vmin,vmax}, opts], for
expressions z, w in u,v, gives the contour lines of w on the surface given
by Plot3D[z,{u,umin,umax},{v,vmin,vmax}, opts].\n
Plot3DContoured[z,{u,umin,umax},{v,vmin,vmax}, opts] gives the same as
Plot3DContoured[{z,z},{u,umin,umax},{v,vmin,vmax}, opts].\n
The contours are controled by ContourPlot options and a new option,
ContourStyleFunction(settings by the latter for any type of directive
overide any settings by the former for the same type)\n
ContourLift sets the amount by which contours are moved towards the
viewpoint to avoid parts of them being hidden by the surface\n
Surface->Transparent gives a wire frame.\n
Linearized ->True give a better fit of contours to surface, more noticeable
when PlotPoints is set low, but the computation takes longer.\n
The options Mesh and MeshStyle control whether the polygon edges are shown
and their styles.\n\n
Options:\n
Plot3DContoured has the union of the options of Plot3D and ContourPlot as
options, together with four new options: ContourLift, ContourStyleFunction,
Linearized and Surface.\n
\n\n
Examples:\n
please enter Plot3DContouredExamples. Input cells will be made below the
entry cell.
";
ContourLift::usage =
"ContourLift is an option for Plot3DContoured, ParametricPlot3DContoured and
Graphics3DContoured.\n
For a number r, ContourLift ->r, causes each contour to be moved towards the
viewpoint by r times the length of the bounding box in the direction of the
view point. This is used to avoid some parts of the contour being covered by
the surface.\n
The default is ContourLift ->Automatic.
";
ContourStyleFunction::usage =
"ContourStyleFunction is an option for Plot3DContoured,
ParametricPlot3DContoured and Graphics3DContoured. \n
ContourStyleFunction ->st, where st is a single entry function causes each
contour to be assigned the style st[wht] where wht is the value of w on the
contour scaled to run from 0 at the lower end of the range of plotted values
of w up to 1 at the top of the range .\n
st[wht] can be a single directive or a list of directives
\n
The default is ContourStyleFunction ->Hue.\n\n
NOTE:\n
Directives set by ContourStyleFunction will override any of the same type
set by ContourStyles.
";
(* Feature to be added later.
ContourStyleFunctionScaling::usage =
"ContourStyleFunctionScaling is an option for Plot3DContoured,
ParametricPlot3DContoured and Graphics3DContoured.\n
With ContourStyleFunctionScaling->False the input to ContourStyleFunction is
the value of w on the contour.\n
With ContourStyleFunctionScaling->True the input to ContourStyleFunction is
the value of w on the contour scaled so that so as to run from 0 at the
least of its plotted values to 1 at their greatest value."
*)
Linearized::usage =
"Linearized is an option for Plot3DContoured, ParametricPlot3DContoured.\n\
Linearized -> True, replaces certain of the internal functions by
linear interpolating functions.
The contours then fit better to the surfaces but the evaluation is slower.\n
The default is Linearized -> False.
";
Surface::usage =
"Surface is an option for Plot3DContoured, ParametricPlot3DContoured and
Graphics3DContoured.\n
Surface -> True, shows the surface on which the contours are to be drawn;\n
Surface -> False hides the surface;\n
Surface -> Transparent gives the surface polygon edges provided that we have
Mesh->True (the style of the mesh controled by the option MeshStyle).\n
The default is Surface -> True.
";
Graphics3DContoured::usage =
"Graphics3DContoured[primitives list, options] is the kind of graphic \
object returned by ParametricPlot3DContoured and Plot3DContoured\n\n
Options:\n
Graphics3DContoured has the union of the options of ContourGraphics, \
SurfaceGraphics and Graphics3D as options, together with three new options
\
ContourLift, ContourStyleFunction and Surface.\n
Graphics3D[Graphics3DContoured]give a Graphics3D object
";
Transparent::usage = "Transparent is a setting for the option Surface in
Graphics3DContoured which specifies that a wire frame version be displayed."
(** EXAMPLES **)
Plot3DContouredExamples :=
CellPrint[
Cell[#, "Input",GeneratedCell->False] & /@
Reverse[
{
"Plot3DContoured[2x^4 - y^4,{x,-1,1},{y,-1,1},Axes->True]",
"Plot3DContoured[{2x^4 - y^4,x y}, {x,-1,1},{y,-1,1},Axes->True]",
"Plot3DContoured[2x^4 - y^4, {x,-1,1},{y,-1,1},Axes -> True,
PlotRange -> {All, {-.2,1.1},All},
ViewPoint->{1.393, -2.988, -0.764}
]",
"pc =
Plot3DContoured[{2x^4 - y^4, x y}, {x,-1,1},{y,-1,1},Axes -> True]",
"Show[pc,
PlotRange -> {All, {-.2,1.1},All},
ViewPoint->{1.393, -2.988, -0.764}
]",
"Show[pc, Lighting -> False, ColorFunction -> GrayLevel]",
"Show[pc, Surface -> False, ContourStyleFunction -> (Hue[1-#]&)]", "Show[pc,
Surface->Transparent,
ColorFunction -> (GrayLevel[.8] &),\n
ContourStyle -> Thickness[.015],
Boxed -> False,
Axes -> False,
PlotRange -> All\n
]",
"Show[pc,
ContourStyle -> Thickness[.007],
ContourStyleFunction->(GrayLevel[0]&),
Mesh -> True,
MeshStyle -> GrayLevel[.5],
Shading -> False
]"
}]];
ParametricPlot3DContouredExamples :=
CellPrint[
Cell[#, "Input", GeneratedCell->False] & /@
Reverse[
{
"ParametricPlot3DContoured[
{t Sin[s] Cos[t], t Cos[s] Cos[t], Sin[t]},
{s,0,2Pi},{t,-Pi/2, Pi/2}
]",
"ParametricPlot3DContoured[
{t Sin[s] Cos[t], t Cos[s] Cos[t], Sin[t],s+t},
{s,0,2Pi},{t,-Pi/2, Pi/2}
]",
"ppc =
ParametricPlot3DContoured[
{t Sin[s] Cos[t], t Cos[s] Cos[t], Sin[t], s+t},
{s,0,2Pi},{t,-Pi/2, Pi/2}
]", "Show[ppc,
PlotRange -> {All, {-.2,1.1},All},
ViewPoint->{1.393, -2.988, -0.764}
]",
"Show[ppc, Lighting -> False, ColorFunction -> GrayLevel]",
"Show[ppc,
Surface -> False,
Contours -> 36,
ContourStyleFunction -> (Hue[1-#]&)
]",
"Show[ppc,
Surface->Transparent,
ColorFunction -> Hue,
Boxed -> False,
Axes -> False
]",
"Show[ppc,
ContourStyle -> Thickness[.007],
ContourStyleFunction->(GrayLevel[0]&),
Mesh -> True,
MeshStyle -> GrayLevel[.5],
Shading -> False
]",
"transparentball =
ParametricPlot3DContoured[
{Sin[s] Cos[t], Cos[s] Cos[t], Sin[t]},
{s,0,2Pi},{t,-Pi/2, Pi/2},
ContourLift -> .7,
AmbientLight -> GrayLevel[.2],
Boxed -> False,
Axes -> False
]",
"(*the following shows how the illusion above is created*)\n
Show[Graphics3D[transparentball], ViewPoint->{3.265, 0.888, 0.042}]",
"(*the contours below are on the true surface - not the polygon
approximation*)\n
ParametricPlot3DContoured[ {t Sin[s] Cos[t], t Cos[s] Cos[t], Sin[t]},
{s,0,2Pi},{t,-Pi/2, Pi/2},
PlotPoints ->7]//Timing",
"
(*Here the contours are on the polygons*)\n
ParametricPlot3DContoured[{t Sin[s] Cos[t],t Cos[s]
Cos[t],Sin[t]},{s,0,2Pi},{t,-Pi/2,Pi/2},PlotPoints->7,
Linearized ->True]//Timing"
}]];
(*** BEGIN PRIVATE CONTEXT ***)
Begin["`Private`"];
Clear["`*"];
Format[Graphics3DContoured[x___]] := "-Graphics3DContoured-";
Options[Graphics3DContoured] =
Union @@ (
{
Options[ContourGraphics],
Options[SurfaceGraphics],
{ ContourLift -> Automatic,
ContourStyleFunction -> Hue,
Surface -> True
}
} /. {
(AspectRatio -> _) -> (AspectRatio -> Automatic),
(AmbientLight -> _) -> (AmbientLight -> GrayLevel[0.]),
(Axes -> _) -> (Axes -> True),
(BoxRatios -> _) -> (BoxRatios -> Automatic),
(ColorFunction -> _) -> (ColorFunction -> Automatic),
(ContourShading -> _) -> (ContourShading -> False),
(ContourSmoothing -> _) -> (ContourSmoothing -> False),
(ContourStyle -> _) -> (ContourStyle -> {}),
(Mesh -> _) -> (Mesh -> False),
(MeshStyle -> _) -> (MeshStyle -> GrayLevel[0])
}
);
Options[ParametricPlot3DContoured] =
Union[
{Compiled -> True, Linearized -> False, PlotPoints -> 25},
Options[Graphics3DContoured]
];
Options[Plot3DContoured] =
Options[ParametricPlot3DContoured]/.
(BoxRatios -> _) -> (BoxRatios -> {1, 1, 0.4});
(* MAIN CODE*)
(*define Plot3DContoured in terms of ParametricPlot3DContoured*)
Plot3DContoured[{z_, w_}, {u_, umin_, umax_}, {v_, vmin_, vmax_},
opts___?OptionQ
] :=
ParametricPlot3DContoured[
{u, v, z, w}, {u, umin, umax}, {v, vmin, vmax},
opts,
FilterOptions[ParametricPlot3DContoured,
Options[Plot3DContoured]
]
];
Plot3DContoured[z_, {u_, umin_, umax_}, {v_, vmin_, vmax_},
opts___?OptionQ
] :=
ParametricPlot3DContoured[
{u, v, z, z}, {u, umin, umax}, {v, vmin, vmax},
opts,
FilterOptions[ParametricPlot3DContoured,
Options[Plot3DContoured]]
];
ParametricPlot3DContoured[
{x_, y_, z_}, {u_, umin_, umax_}, {v_, vmin_, vmax_},
opts___?OptionQ
] :=
ParametricPlot3DContoured[
{x, y, z, z}, {u, umin, umax}, {v, vmin, vmax},
opts
];
ParametricPlot3DContoured[
{x_, y_, z_, w_}, {u_, umin_, umax_}, {v_, vmin_, vmax_}, opts___?OptionQ
] :=
Module[{px, py, pz, pw, ddu, ddv, defopts, ppts, polydat, zdat, mr,
graphicsobject},
(** STEP1 : construct the basic data that depends only on the
parametric formulas x, y, z, the u and v ranges and the "plot" option
PlotPoints. This will be passed on unchanged through any uses of Show.
**)
(*Find the current default options-- to allow control by the SetOptions
function.*)
defopts = Sequence @@ Options[ParametricPlot3DContoured];
ppts = PlotPoints /. {opts} /. {defopts};
(*Make functions {px, py, pz, pw} out of {x, y, z, w} :
these are convenient for passing.*)
{ddu, ddv} = {umax - umin, vmax - vmin}/(ppts - 1);
{px, py, pz, pw} =
Which[
Linearized /. Flatten[{opts, defopts}],
Interpolation[
Flatten[
Table[{u, v, #},
{u,umin,umax,ddu},{v,vmin,vmax,ddv}
],
1
],
InterpolationOrder -> 1
] & /@ {x, y, z, w},
Compiled /. Flatten[{opts, defopts}],
Thread[comp[{u, v}, {x, y, z, w}], List, -1] /. comp -> Compile,
True,
Function /@ ({x, y, z, w} /. {u :> #1, v :> #2})
];
(*Find the polygons, polydat, for surface on which the contours will be
drawn. The extra enclosing brackets are to conform to the pattern when
directives are added.*)
polydat = {List /@
ParametricPlot3D[{x, y, z}, {u, umin, umax}, {v, vmin, vmax},
DisplayFunction -> Identity, PlotPoints -> ppts
][[1]]};
(*Find matrix of heights, wdat, as a function of u, v -- the x,
y coordinates will be adjusted later. We need the meshrange mr so that the
original values of u and v can be reconstructed.*)
wdat = Table[w, {v, vmin, vmax, ddv}, {u, umin, umax, ddu}];
zdat = Table[z, {v, vmin, vmax, ddv}, {u, umin, umax, ddu}];
mr = {{umin, umax}, {vmin, vmax}};
(*Pass data on to the function makegraphics to make a Graphics3DContoured
object
1. The {}'s hold places for data that depends on Graphics3DContoured options
to be added.
2. metdat will be the value of {Boxratios, PlotRange} that have actually
been used in a plot. These will be obtained using the function FullOptions
and need not be the values assigned by the options (because, for example,
PlotRange -> Automatic is a default setting).
3. cdat will be the data from which the contour lines will be constructed
once their number and other properties have been specified.
*)
(**STEP2 :
Use the function makegraphics, defined later, to construct a graphics object
with new head Graphics3DContoured.This will contain all the data, including
all the options given, from which to display the result.
**)
graphicsobject =
makegraphics[{{px, py, pz, pw}, zdat, wdat,
polydat,
{}(*space for metdat*),
{}(*space for cdat*)},
FilterOptions[Graphics3DContoured,
MeshRange -> mr, opts,
defopts
]
];
(*Show the graphics just constructed.*)
(**STEP3 :
display the result by means of an extended version of the
function Show, defined later.
**)
Show[graphicsobject]];
(*The function makegraphics, defined below, gives a ContouredSurfaceGraphics
object.A principle aim in designing the
code has been to keep recomputation as close as sensible to the minimum
required by new option settings introduced by when using Show.*)
(*UVP, below, converts the viewpoint, vp, from viewpoint coordinates to user
coordinates. VP converts from user coordinates to viewpoint coordinates*)
UVP[vp_, br_, pr_] := pr.{1, 1}/2 + pr.{-1, 1} Max[br]/br vp;
VP[uvp_, br_, pr_] := (uvp - pr.{1, 1}/2)br/Max[br]/pr.{-1, 1};
zscaler =
Compile[{n1, n2, n3, n4, m, h}, ((n1 + n2 + n3 + n4)/4 - m)/h];
makegraphics[{{px_, py_, pz_, pw_}, zdat_, wdat_, oldpolydat_, oldmetdat_,
oldcdat_, oldopts___}, newopts___
] :=
Module[{optsset, opts, vp, br, cl, csf, pcf, clnsQ, edgfm, msh,
mshs, cs, sur, ppts, lftrat, pr, cln, cplot, cplot2D, uvp,
center, ucp, maxs, tmin, thbx, zpr, zmin, hbx, newcdat,
clines, us, vs, zav, xyz, vecs, unitvecs, cyclestyles,
csc, clip, nearpt, lift, lftpt, dpr, dvp, gr1
},
(*Find the list of options that are set in newopts*)optsset =
First /@ {newopts};
(*Join newopts and oldopts for convenience.*)
opts = Sequence[newopts, oldopts];
(*Find the settings of some of the options.*)
{br, csf, cl, clnsQ, cs, mshQ, mshs, pcf, vp} =
{BoxRatios, ContourStyleFunction, ContourLift, ContourLines,
ContourStyle, Mesh, MeshStyle, ColorFunction, ViewPoint} /. {opts};
edgfm = If[!mshQ, EdgeForm[], EdgeForm[mshs]];
newpolydat = {edgfm, Last[oldpolydat]};
(*If newopts change plotrange or box ratios find their new values.*)
{newfbr, newfpr} =
If[MemberQ[optsset, BoxRatios | PlotRange],
FullOptions[
Graphics3D[newpolydat,
FilterOptions[Graphics3D, opts]
],
{BoxRatios, PlotRange}
],
oldmetdat
];
(*Find the thickness of the box, thbx,(in user coordinates) along the
line through the center and the viewpoint.*)
uvp = UVP[vp, newfbr, newfpr];(*Viewpoint in user coordinates*)
center = newfpr.{1, 1}/2;
ucp = uvp - center;
maxs = Max /@ newfpr;
Off[Power::infy];
tmin = Min[Abs[(maxs - center)/ucp]];
On[Power::infy];
thbx = 2 tmin Sqrt[ucp.ucp] //
N; (*Find the ratio lftrat of the thickness of the box
in the direction of the view point by which the contours
will be lifted*)
ppts = Dimensions[wdat];
lftrat := If[cl === Automatic, 0.5/(Plus @@ ppts), cl];
(*Find a display plotrange, dpr, which will include the
lifted contours. Calculate the corresponding display box ratio dbr and
display ViewPoint, dvp the position of the latter in user coordinates
relative to br and dpr is still uvp (this will keep the lifted contours in
line with the unlifted ones as seen from the view point used in the
display).
*)
clip[x_, {a_, b_}] := Which[x < a, a, x > b, b, True, x];
nearpt[uvp_, newfpr_] := Thread[clip[uvp, newfpr]];
lift[uvp_, pr_, d_] :=
Module[{np}, np = nearpt[uvp, pr];
(np + d #/Sqrt[#.#]) &[uvp - np]
];
lftpt = lift[uvp, newfpr, lftrat thbx];
dpr = {Min[#], Max[#]} & /@ MapThread[List, {lftpt, newfpr}];
dbr = If[br === Automatic, dpr.{-1, 1}, br];
dvp = VP[uvp, dbr, dpr];
(*Find the height, hbx, of the box in user coordinates,
needed to find the scaled height used for ContourStyleFunction.*)
wmin = Min[wdat];
wmax = Max[wdat];
wrange = wmax - wmin;
znewfpr = newfpr[[-1]];
zmin = Min[znewfpr];
zmax = Max[znewfpr];
hbx = zmax - zmin;
(*Find the 2D contour lines from wdat by using ContourGraphics
and converting to a Graphics object.The heights will be added
later and the u, v coordinates will be mapped to the corresponding x, y
values.
The split into styles and lines is for efficiency in making \
changes by options.*)
{styles, lines} =
If[(gr1 =
Graphics[
ContourGraphics[wdat, ContourShading -> False,
FilterOptions[ContourGraphics,
PlotRange -> {wmin,
wmax} ,opts]]][[
1]] /. {dirs__, ln_Line} -> {{dirs},
ln}) === {}, {{}, {}}, Transpose[gr1]];
(*Do those calculations for lifting the contours that depend on the
"metric" options BoxRatios, Contours, PlotRange, ViewPoint,
ContourSmoothing.Store the data as newcdat. The full code for the contour
lines is constructed later from newcdat and styles. *)
If[
clnsQ && MemberQ[
optsset, BoxRatios | ViewPoint | PlotRange |
Contours | ContourSmoothing
],
newcdat =
If[lines === {},
{},
lines /. Line[ps_] :> (
{us, vs} = Transpose[ps];
wav = Inner[pw, us, vs]/Length[ps];
(*av of w on contour*)
ws = Table[wav, {Length[ps]}];
xyz =
{MapThread[px, {us, vs}],
MapThread[py, {us, vs}],
MapThread[pz, {us, vs}]
};
vecs = Transpose[uvp - xyz];
unitvecs =
(*unit vecs in direction of viewpoint*)
Block[{Dot},
vecs/Sqrt[
Thread[Dot[vecs, vecs]]
]
];
{
(wav - wmin)/wrange, Transpose[xyz], thbx unitvecs
}
)
],
(*else - if no changes are needed to cdat.*)
newcdat = oldcdat
];
(*Insert the directives for the polygons*)
If[pcf =!= Automatic && MemberQ[optsset, ColorFunction],
newpolydat =
newpolydat /.
{___, poly : Polygon[pts_]} :>
{pcf[zscaler[Sequence @@ (Last /@ pts),zmin,hbx]], poly}
];
(*Complete the code for the contour lines using lftrat (derived from the
option ContourLift) and csf (from ContourStyleFunction).*)
clines =
If[clnsQ,
Apply[
{Sequence @@ Flatten[{##4}],
Sequence @@ Flatten[{csf[#1]}],
Line[#2 + lftrat #3]
}&,
MapThread[Join, {newcdat, styles}],
{1}
],
{}
];
(*Return the data and options as a Graphics3DContoured object*)
Graphics3DContoured[{{px, py, pz, pw}, zdat, wdat,
newpolydat, {newfbr, newfpr}, newcdat, clines, {dpr, dvp}}, opts]
];
(*Extend Show to deal with Graphics3DContoured objects.*)
Graphics3DContoured /:
Show[
Graphics3DContoured[
{fn_, zdat_, wdat_, polydat_, {fbr_, fpr_}, cdat_, clines_, {dpr_,
dvp_}
},
oldopts___?OptionQ
],
newopts___?OptionQ
] :=
If[ MemberQ[First /@ {newopts},
BoxRatios | ColorFunction | ContourStyleFunction | ContourLift
|Contours | ContourLines | ContourSmoothing | ContourStyle | Mesh
|MeshStyle | PlotRange | Surface | ViewPoint
],
Show[
makegraphics[
{fn, zdat, wdat, polydat, {fbr, fpr}, cdat, oldopts},
newopts
]
],
Show[
Graphics3D[
{Switch[Surface /. {newopts, oldopts},
True, polydat,
Transparent,
polydat /.
Polygon[z_] :>
Line[Append[z, First[z]]], _, {}],
If[ContourLines /. {newopts, oldopts},
clines,
{}]}
],
PlotRange -> dpr, ViewPoint -> dvp,
FilterOptions[Graphics3D, newopts, oldopts]
];
Graphics3DContoured[ (*output*)
{fn, zdat, wdat, polydat, {fbr, fpr}, cdat, clines,
{dpr, dvp}},
newopts, oldopts
]
];
(*Provide for conversion of Graphics3DContoured objects to Graphics3D
objects*)
Graphics3DContoured /:
Graphics3D[
Graphics3DContoured[
{fn_, zdat_, wdat_, polydat_, {fbr_, fpr_}, cdat_, clines_, {dpr_, dvp_}},
oldopts___?OptionQ
],
newopts___?OptionQ
] :=
Graphics3D[
{Switch[Surface /. {newopts, oldopts},
True,
polydat,
Transparent,
polydat /.
Polygon[z_] :>
Line[Append[z, First[z]]],
_, {}
],
If[ContourLines /. {newopts, oldopts}, clines, {}]
},
PlotRange -> dpr, ViewPoint -> dvp,
FilterOptions[Graphics3D, newopts, oldopts]
];
End[];
Protect["`*"];
EndPackage[]
"Borut L" <borut at email.si> wrote in message news:9di08i$kus at smc.vnet.net...
> Good day,
>
> I made a function which displays 3D contour lines onto Surface Graphics.
> It's pretty neat. There is a problem though. The contours "fit" so
perfecty
> onto the surface that they [are] a part of the surface - so half visible
> half hidden by the surface - they seem to intersect.
>
> I also came across an article in old Mathematica Journal which explains
the
> method and also mentions the problem but do not address it in details.
>
> So I ask you mighty Mathematicians if you know a simple solution. ?
>
> Is there even simpler way to make 3D contours... please point me to an
> eventual news thread. ?
>
>
> Thanks a lot,
>
> Borut Levart,
>
>
> a physics student from Slovenia
>
>
>