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$
15
  • 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$ Commented Jun 11, 2014 at 11:00
  • $\begingroup$ Have you looked at the Opacity directive for the code that generates isosurface? $\endgroup$ 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$ Commented Jun 11, 2014 at 14:00
  • $\begingroup$ mathematica.stackexchange.com/questions/3665/… $\endgroup$ Commented Jun 11, 2014 at 16:31
  • $\begingroup$ added the code and the data $\endgroup$ Commented Jun 11, 2014 at 18:09

2 Answers 2

Reset to default
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

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$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.