0
$\begingroup$

I am trying to combine two graphics objects using Show.

The first one is an isosurface:

data = Import["/PATH/furan-ks.sdat", "Table"];
ALEE = Nearest[data[[All, {1, 2, 3}]] -> Rescale[data[[All, 4]]]];
cfALEE = ColorData["Rainbow"]@First@ALEE[{#1, #2, #3}] &;
isosurface=ListSurfacePlot3D[data[[All, {1, 2, 3}]], BoxRatios -> Automatic, 
ColorFunction -> cfALEE, ColorFunctionScaling -> False, 
Boxed -> False, Axes -> False, Mesh -> None, MaxPlotPoints -> 25, 
ImageSize -> 500]

isosurface

The second one is a sequence of points:

 geom = Import["/PATH/furan.geom", "Table"];
 AngToAu = 1.88971616463;
 Function[x, x*AngToAu];
 geom = Map[%, geom, {2}];
 Show[Graphics3D[{Black, PointSize[0.05], Point[geom]}, Boxed -> False]]

points

I want the points to appear on the same plot as the surface and be plotted at the appropriate scale. A command I am using:

Show[isosurface, Graphics3D[{Black, PointSize[0.05], Point[geom]}, Boxed -> False]]

The catch is that the points effectively appear inside the surface and are NOT visible. I need to somehow project them on the surface or make them visible through the surface.

How do I deal with this? Any suggestions?

EDIT: attached the files isosurface geom

$\endgroup$
16
  • 5
    $\begingroup$ You could make Tubes out of it? I'm afraid that you should provide the code for the isosurface and the points so one can reproduce it. $\endgroup$
    – Öskå
    Commented Jun 11, 2014 at 11:00
  • $\begingroup$ Have you looked at the Opacity directive for the code that generates isosurface? $\endgroup$
    – m_goldberg
    Commented Jun 11, 2014 at 12:31
  • $\begingroup$ you may use Overlay and SetAlphaChannel Overlay[{isosurface, SetAlphaChannel[ Graphics3D[{Black, PointSize[0.05], Point[geom]}, Boxed -> False], .5]}, All, 2] $\endgroup$
    – s.s.o
    Commented Jun 11, 2014 at 14:00
  • $\begingroup$ mathematica.stackexchange.com/questions/3665/… $\endgroup$
    – george2079
    Commented Jun 11, 2014 at 16:31
  • $\begingroup$ added the code and the data $\endgroup$
    – molkee
    Commented Jun 11, 2014 at 18:09

2 Answers 2

2
$\begingroup$

Here is what I would propose:

AngToAu = 1.88971616463;
geom = AngToAu*Import["~/Downloads/furan.geom", "Table"];
pts = Show[
   Graphics3D[{Black, PointSize[0.05], Point[geom]}, Boxed -> False]];

data = Import["~/Downloads/furan-ks.sdat", "Table"];
ALEE = Nearest[data[[All, {1, 2, 3}]] -> Rescale[data[[All, 4]]]];
cfALEE = ColorData["Rainbow"]@First@ALEE[{#1, #2, #3}] &;
data = data[[All, {1, 2, 3}]];
isosurface = 
  ListSurfacePlot3D[data, BoxRatios -> Automatic, Boxed -> False, 
    Axes -> False, Mesh -> None, MaxPlotPoints -> 25, ImageSize -> 250, 
    RegionFunction -> Function[{x, y, z}, 
      And @@ (Norm[{y - #[[2]], z - #[[3]]}] >= .4 & /@ geom)], 
    PlotStyle -> [email protected]]

Producing your shell with holes as a projection of geom thanks to RegionFunction:

Then, you can either add your points:

Show[pts, isosurface]

Mathematica graphics

or create Tubes out of them:

points = Cases[Normal[isosurface], Line[x__] :> x, \[Infinity]];
centers = Mean /@ (Select[#, First@# > 0 &] & /@ points /. {{} -> Sequence[]});
coorTube = {# - {First@#2, 0, 0}, # + {First@#2, 0, 0}} & @@@ 
  Thread@{SortBy[geom, Last], SortBy[centers, Last]};
Show[
  Graphics3D[{White, [email protected], Tube[#, 0.4] & /@ coorTube}, Boxed -> False],
  pts, isosurface]

Mathematica graphics

$\endgroup$
1
$\begingroup$

Quick and dirty, rasterize the 3d and overlay a 2d graphic:

     Show[{Rasterize[ 
           Show[ExampleData[{"Geometry3D", "Torus"}], ViewPoint -> {0, 0, 1}] ,
                ImageSize -> {400, 400}], Graphics[Disk[125 {Sin[2 # Pi/6],
                     Cos[2 # Pi/6]} + {200, 200}, 20] & /@ Range[6]]}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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