# Mathematica and POV-Ray workflow: ListContourPlot3D

I have the following function describing a molecular electronic Orbital.

f[r_] = E^-((r - R0)/\[CapitalDelta]r)^2;

r = Sqrt[x^2 + y^2 + z^2];
cosphi[x_, y_, z_] := If[x == 0 &&  y == 0 && z == 0, 0, z/r];

\[Rho][x_, y_, z_] =
f[Sqrt[x^2 + y^2 + z^2]] (c0 LegendreP[0, cosphi[x, y, z]] +
c1 LegendreP[1, cosphi[x, y, z]] +
c2 LegendreP[2, cosphi[x, y, z]] +
c3 LegendreP[3, cosphi[x, y, z]] +
c4 LegendreP[4, cosphi[x, y, z]] +
c5 LegendreP[5, cosphi[x, y, z]] +
c6 LegendreP[6, cosphi[x, y, z]] +
c7 LegendreP[7, cosphi[x, y, z]] +
c8 LegendreP[8, cosphi[x, y, z]]);

R0 = 0.55; \[CapitalDelta]r = 0.125;
c0 = 1; c1 = 0.1; c2 = 0.25; c3 = -0.3; c4 = 0.1; c5 = 0.1; c6 = \
-0.1; c7 = -0.05; c8 = 0.03;


In order to plot this I have to use the ListContourPlot3D:

data = Table[\[Rho][x, y, z], {x, -0.7, 0.7, .05}, {y, -0.7,
0.7, .05}, {z, -0.7, 0.7, .05}];
SO = ListContourPlot3D[data, Contours -> {0.75}, Mesh -> None,
DataRange -> {{-0.7, 0.7}, {-0.7, 0.7}, {-0.7, 0.7}}]


Now I need this Plot inside POV-Ray, so I adapted the workaround presented here :

vertices = SO[[1, 1]];
triangles = Cases[SO, Polygon[x_, ___] :> x, \[Infinity]][[1]];
normals = SO[[1, 3, 2]];

AccString[x_List] :=
StringDrop[
StringJoin[
Map[ToString[AccountingForm[#, 20, NumberSigns -> {"-", ""}]] <>
"," &, x[[{1, 2, 3}]]]], -1]

POVsmoothtriangle[ind_List] :=
StringJoin[{"smooth_triangle{<", AccString[vertices[[ind[[1]]]]],
">,<", AccString[normals[[ind[[1]]]]], ">,<",
AccString[vertices[[ind[[2]]]]], ">,<",
AccString[normals[[ind[[2]]]]], ">,<",
AccString[vertices[[ind[[3]]]]], ">,<",
AccString[normals[[ind[[3]]]]], ">}"}]

Export["SO.inc",
Join[{"#declare SOsurface = mesh{"},
Map[POVsmoothtriangle, triangles], {"}"}], "Lines"]


Doing so I encountered the following problem: It seems to be impossible to connect the individual triangles (polygons). This leads to unserviceable POVRay-Plots with huge gaps between the triangles. e.g. (Mathematica Plot top left)

Some suggest to just increase the resolution. Since the ListContourPlot3D needs precalculated data I found no option to increase the resolution of the plot other than increase the number of points saved in data by decreasing the stepwidth e.g.

 data = Table[\[Rho][x, y, z], {x, -0.7, 0.7, .01}, {y, -0.7, 0.7, .01}, {z, -0.7, 0.7, .01}];


This in fact produces more triangles but also shrinks them. So there is no improvement at all. Does anyone has a smart idea how to fix this?

• I was doing the same thing as you, but I was plotting atomic orbitals. What I did is the following: 1. I plot the orbital in Mathematica in 2D using ContourPlot. 2. Extract the contours 3. Plot the 3D surface from the contours using RevolutionPlot3D. 4. Export the 3D object to povray and render. Hope that helps. – xslittlegrass Jun 22 '15 at 22:08