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

| improve this question | |
$\endgroup$
  • 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å Jun 11 '14 at 11:00
  • $\begingroup$ Have you looked at the Opacity directive for the code that generates isosurface? $\endgroup$ – m_goldberg Jun 11 '14 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 Jun 11 '14 at 14:00
  • $\begingroup$ mathematica.stackexchange.com/questions/3665/… $\endgroup$ – george2079 Jun 11 '14 at 16:31
  • $\begingroup$ added the code and the data $\endgroup$ – molkee Jun 11 '14 at 18:09
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 -> Opacity@.5]

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, Opacity@.5, Tube[#, 0.4] & /@ coorTube}, Boxed -> False],
  pts, isosurface]

Mathematica graphics

| improve this answer | |
$\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

| improve this answer | |
$\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.