4
$\begingroup$

I have a 3D model of a heart in Mathematica and I'm trying to create a plane so that the open surface (as seen in the image below) is cut off so that the heart can have a solid, level surface. How can I combine this plane with my 3D contour plot?

heart = (2 x^3 + y^2 + z^2 - 1)^3 - (1/10) x^2 z^3 - y^2 z^3
planey = z
g = {Normal[      
   ContourPlot3D[{heart == 0}, {x, -1.5, 1.5}, {y, -1.5, 
     1.5}, {z, -1.5, 1.5}, Mesh -> None, 
    ContourStyle -> Opacity[0.8, Red]]   ], planey}
 gn = Normal[
  g /. GeometricTransformation[prims_, 
     tf_List] :> (GeometricTransformation[prims, #] & /@ tf)]

enter image description here

$\endgroup$
  • $\begingroup$ Welcome to Mathematica.SE! I suggest that: 1) You take the introductory Tour now! 2) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! 3) As you receive help, try to give it too, by answering questions in your area of expertise. $\endgroup$ – bbgodfrey Feb 14 '15 at 4:47
5
$\begingroup$

You can also use RegionPlot3D:

RegionPlot3D[
 reg = (2 x^3 + y^2 + z^2 - 1)^3 - (1/10) x^2 z^3 - y^2 z^3 <= 0 && 
   x >= 0, {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, Mesh -> None, 
 Boxed -> False, Axes -> None, PlotPoints -> 40, PlotStyle -> Red, 
 Background -> Black]

enter image description here

Implicit regions could be refined but is not as pleasing "out of the box", e.g.

DiscretizeRegion[ImplicitRegion[reg, {x, y, z}], Table[{-2, 2}, {3}]],
  MeshCellStyle -> {1 -> None, 2 -> Red}]

enter image description here

$\endgroup$
  • $\begingroup$ Awesome, thanks! $\endgroup$ – Kolibrie Feb 14 '15 at 13:50
3
$\begingroup$

Will this help you?

c1 = ContourPlot3D[{heart == 0}, {x, -1.5, 1.5}, {y, -1.5, 1.5}, {z, -1.5, 1.5}, 
 Mesh -> None, ContourStyle -> Opacity[0.8, Red], 
 RegionFunction -> Function[{x, y, z}, x > -0.3]];
c2 = ContourPlot3D[x == -.3, {x, -1.5, 1.5}, {y, -1.5, 1.5}, {z, -1.5, 1.5}, 
  Mesh -> None, ContourStyle -> Opacity[0.8, Blue], 
  RegionFunction -> Function[{x, y, z}, heart < 0]];
Show[c1, c2]

Mathematica graphics

$\endgroup$
  • $\begingroup$ That's helpful, but I still need the open surface that lets the heart become a bowl to be intersected by a plane or solidify the entire heart. $\endgroup$ – Kolibrie Feb 14 '15 at 4:28
  • $\begingroup$ Well, just do it the other way around to close the heart: Use the heart expression of RegionFunction and draw a parametric plane. Please look at the other styling options like BoundaryStyle too. $\endgroup$ – halirutan Feb 14 '15 at 4:40
2
$\begingroup$

You can replace the boundary Line with a Polygon:

heart = (2 x^3 + y^2 + z^2 - 1)^3 - (1/10) x^2 z^3 - y^2 z^3;
g = Show[
  ContourPlot3D[heart == 0,
    {x, 0., 1.5}, {y, -1.5, 1.5}, {z, -1.5, 1.5},
    Mesh -> None, PlotPoints -> 40, ContourStyle -> Opacity[0.8, Red],
     AxesLabel -> Automatic] /. 
   Line[p_] :> {Opacity[0.8, Red], EdgeForm[], 
     Polygon[p, VertexNormals -> ConstantArray[{-1, 0, 0}, Length[p]]]},
  PlotRange -> 1.5]

Mathematica graphics

RegionPlot3D works too:

Show[
 RegionPlot3D[heart <= 0,
  {x, 0., 1.5}, {y, -1.5, 1.5}, {z, -1.5, 1.5},
  Mesh -> None, PlotPoints -> 40, PlotStyle -> Opacity[0.8, Red], 
  AxesLabel -> Automatic],
 PlotRange -> 1.5]

Mathematica graphics

BoundaryStyle may be used to remove or change the edge.

Happy Valentine's Day!

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.