How to get colors at points in Graphics3D?

Question

To get the color at a 2D point in Graphics you can Rasterize it and look up the pixel value, but not for Graphics3D. Is there anyway to do this in the 3D case?

Here's the 2D solution:

g = Graphics[{Texture[ExampleData[{"TestImage", "Sailboat"}]], 
       Polygon[{{0, 0}, {1, 0}, {1/2, 1}}, 
    VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1/2, 1}}]}, 
    Background -> None, PlotRangePadding -> 0]
img = Rasterize @ g; dim = ImageDimensions @ img;
colorAtPoint2D[pt_] := RGBColor @@ ImageValue[img, pt*dim]
colorAtPoint2D /@ RandomPoint[DiscretizeGraphics[g], 10]

The main difficulty is that Rasterize doesn't return an Image3D on Graphics3D. So how can one workaround this limitation to implement a colorAtPoint3D?

Answer 1

UPDATE #3: As discussed in the comments, the method used (looking from the top) does not capture points on vertical surfaces. This is an attempt to use 3 orthogonal view points. For a cube like the one we have been using for an example, one of the three views will capture the color and the other two will get the background that is now set to transparent. So it is just a matter of returning the colored result. Things get more complicated for a surface viewed at an angle. It turns out that we get colors from the three views but they are not exactly the same (although proportions are close). Each returns a color apparently mixed with some background, with the result that each color has a different opacity. The function attemps to fix this by taking the result with the greatest opacity and correcting the color, based on this opacity, to return an opaque color. Unfortunately, I can't get enough good sample cases to properly test this. I can create the surface at an angle but figuring out coordinates of points on this surface to test is not obvious. The code is about three times slower than before since we use three views. Not too useful, but interesting anyway.

colorAtPoint3DAll[g_, p_] := (
  
  opt = AbsoluteOptions[g, PlotRange];
  pr = List @@ opt[[1]][[2]];
  xmax = 2*Abs[pr[[1]][[2]]];
  ymax = 2*Abs[pr[[2]][[2]]];
  zmax = 2*Abs[pr[[3]][[2]]];
  results = {};
  st = 0.003;
  g3dx = Show[g, PlotRange -> All, PreserveImageOptions -> False, 
    ImagePadding -> None, ImageMargins -> 0, 
    ViewVector -> {{xmax, p[[2]], p[[3]]}, p}, 
    ViewRange -> 
     Sort[{Abs[xmax - p[[1]] - st], Abs[xmax - p[[1]] + st]}], 
    Boxed -> False, PlotRangePadding -> None, Background -> None];
  g3dy = Show[g, PlotRange -> All, PreserveImageOptions -> False, 
    ImagePadding -> None, ImageMargins -> 0, 
    ViewVector -> {{p[[1]], ymax, p[[3]]}, p}, 
    ViewRange -> 
     Sort[{Abs[xmax - p[[2]] - st], Abs[xmax - p[[2]] + st]}], 
    Boxed -> False, PlotRangePadding -> None, Background -> None];
  g3dz = Show[g, PlotRange -> All, PreserveImageOptions -> False, 
    ImagePadding -> None, ImageMargins -> 0, 
    ViewVector -> {{p[[1]], p[[2]], zmax}, p}, 
    ViewRange -> 
     Sort[{Abs[xmax - p[[3]] - st], Abs[xmax - p[[3]] + st]}], 
    Boxed -> False, PlotRangePadding -> None, Background -> None];
  images = 
   Table[Image[k, ImageSize -> {All, All}], {k, {g3dx, g3dy, g3dz}}];
  dims = ImageDimensions /@ images;
  colors = 
   Table[RGBColor[
     ImageValue[images[[j]], dims[[j]] {0.5, 0.5}]], {j, {1, 2, 3}}];
  
  color = Cases[colors, Except[RGBColor[{0., 0., 0., 0.}]]];
  done = False;
  If[Length[color] == 0, finalColor = RGBColor[{0., 0., 0., 0.}],
   n = 1;
   maxOp = {0, 0};
   While[n <= Length[color],
    l = Length[color[[n]]];
    If[l == 3 || color[[n]][[1]][[4]] == 1, finalColor = color[[n]]; 
     done = True,
     lc = List @@ color[[n]][[1]];
     If[lc[[4]] > maxOp[[2]], maxOp = {n, lc[[4]]}];
     ];
    n++;
    ];
   If[! done,
    t = maxOp[[1]];
    lc = List @@ color[[t]][[1]];
    new = {0, 0, 0};
    new[[1]] = lc[[1]] + ((lc[[4]])*lc[[1]]);
    new[[2]] = lc[[2]] + ((lc[[4]])*lc[[2]]);
    new[[3]] = lc[[3]] + ((lc[[4]])*lc[[3]]);
    finalColor = RGBColor[new];
    ]
   ];
  finalColor
  )

UPDATE #2: Here is a version of the same approach that considers the issue of view versus intrinsic color for a point. In the example given below, if you ask the color of a point in the middle of the cylinder with the original code, you get Pink because you see the bottom of the cylinder. But the point is really just background. This new function encompasses the original approach (use FALSE for the useSlice parameter) or a new approach (use TRUE) that uses the camera ViewRange to select a thin slice encompassing the point of interest. The thickness of this slice can be controlled by setting the value of st in the function. As a result, colors in the background are not interfering. Only points intrinsically colored will show. This function also does away with the coordinate transform by positioning the view point right above the point of interest. This will put the point of interest in the middle of the image {0.5,0.5}.

colorAtPoint3DX[g_, p_, useSlice_] := (
  opt = AbsoluteOptions[g, PlotRange];
  pr = List @@ opt[[1]][[2]];
  zmax = 2*Abs[pr[[3]][[2]]];
  If[! useSlice,
   hyReg = Hyperplane[{0, 0, 1}, {p[[1]], p[[2]], p[[3]] + 0.001}];
   g3d = Show[g, PlotRange -> All, PreserveImageOptions -> False, 
     ImagePadding -> None, ImageMargins -> 0, 
     ViewVector -> {{p[[1]], p[[2]], zmax}, p}, Boxed -> False, 
     PlotRangePadding -> None, ClipPlanes -> hyReg, 
     ViewRange -> All],
   st = 0.001;
   g3d = Show[g, PlotRange -> All, PreserveImageOptions -> False, 
      ImagePadding -> None, ImageMargins -> 0, 
      ViewVector -> {{p[[1]], p[[2]], zmax}, p}, 
      ViewRange -> 
       Sort[{Abs[zmax - p[[3]] - st], Abs[zmax - p[[3]] + st]}],
       Boxed -> False, PlotRangePadding -> None];
   ];
  im = Image[g3d, ImageSize -> {All, All}];
  dim = ImageDimensions@im;
  RGBColor[ImageValue[im, dim {0.5, 0.5}]]
  )

UPDATE #1: Code modified. One of the main problem was that Mathematica adds 4% of PlotRangePadding, which was not considered in the calculation using PlotRange. The code now specifies PlotRangePadding->None.

---

Here is an attempt. A clip plane parallel to the xy-plane goes (almost) through the point we want to know the color of so that what appears above that point is removed. We then use a view point from the top to look at the image of the plane and access the point using 2D coordinates.

colorAtPoint3D[g_, p_] := (
  hyReg = Hyperplane[{0, 0, 1}, {p[[1]], p[[2]], p[[3]] + 0.001}];
  
  g3d = Show[g, PlotRange -> All, PreserveImageOptions -> False, 
    ImagePadding -> None, ImageMargins -> 0, 
    ViewPoint -> {0, 0, Infinity}, ClipPlanes -> hyReg, 
    Boxed -> False, PlotRangePadding -> None];
  im = Image[g3d, ImageSize -> {All, All}];
  opt = AbsoluteOptions[g3d, PlotRange];
  pr = List @@ opt[[1]][[2]];
  dim = ImageDimensions@im;
  tfunc = 
   RescalingTransform[{{pr[[1]][[1]] , pr[[1]][[2]]}, {pr[[2]][[1]] , 
      pr[[2]][[2]]}}, {{0, dim[[1]] - 1}, {0, dim[[2]] - 1}}];
  RGBColor[ImageValue[im, tfunc[{p[[1]], p[[2]]}]]]
  )
  

Here is an example:

gr = Graphics3D[{FaceForm[Blue, Pink], Cylinder[], Red, 
   Sphere[{0, 0, 2}, 0.8], Black, Thick, Dashed, 
   Line[{{-2, 0, 2}, {2, 0, 2}, {0, 0, 4}, {-2, 0, 2}}], Yellow, 
   Polygon[{{-3, -3, -2}, {-3, 3, -2}, {3, 3, -2}, {3, -3, -2}}], 
   Green, Opacity[0.3], Cuboid[{-2, -2, -1.4}, {2, 2, -1.1}], 
   Opacity[1], Orange, Point[{1, 0.5, -0.5}], Point[{1.5, 0.7, -0.5}],
    ImagePadding -> None, ImageMargins -> 0}]

Suppose we want the color at coordinate {1.5, 0.7, -0.5}. This is an orange point.:

colorAtPoint3D[gr, {1.5, 0.7, -0.5}]   (* Orange *)

In this example, the 3D image is cut by the clip plane and then viewed from the top. This is the resulting 2D image. The blue cylinder was cut at the level of the orange dot, so we see the pink color inside it:

Another example. The point {0,0,2} results in a cut of the red sphere and returns the color red.

colorAtPoint3D[gr, {0, 0, 2}]   (* Red *)

Issues: M.R. Thank you for your response below. The main issue I had is the rescaling transform, which converts the Graphics3D coordinates to image coordinates. This issue seems to be solved with the removal of PlotRangePadding.

To analyze the results of a particular trial, you can look at the following after running the code:

• im : the resulting 2D image. If you test with a point, make sure you see the point in the image. The code adds a small value to the z coordinate (0.001). Otherwise the point may be removed by the clip plane.
• pr: the plot range in x,y,z. May involve negative values.
• tfunc: running tfunc[x,y], where x,y are the 2D Graphics3D coordinates of the point will give the resulting image coordinates. If you are looking for a Red point, you may find the coordinates where this color appears with ImageValuePositions[im, Red]. This result can be compared with the result of the tfunc call to see how off the result is.

Image3D: As an aside, I tried slicing a Graphics3D with thin slices from bottom to top using the camera ViewRange as described earlier, to create an Image3D. It works more or less: you can minipulate the image in 3D, search colors of pixels directly from coordinates, etc. But horizontal slices of this kind do a bad job with vertical surfaces.

Response to M.R. concerning your Response to Update 2 below: If you look at your Show line, you will see that you did not add the red point to gr. If you correct this it will work:

gr = Show[gr, Graphics3D[{Red, Point[p = {-1, -.3, 0.2}]}]] (* this isn't what I want, I was only using red to indicate where the point is *)

Response to Update #2:

My basic texture example is still broken. Try this:

sides = CloudGet[
   "https://www.wolframcloud.com/obj/efc1293a-979c-47e2-bcfb-6d80d4a04cea"];

v = {{-1, -1, -1}, {1, -1, -1}, {1, 1, -1}, {-1, 1, -1}, {-1, -1, 
    1}, {1, -1, 1}, {1, 1, 1}, {-1, 1, 1}};
idx = {{1, 2, 3, 4}, {1, 2, 6, 5}, {2, 3, 7, 6}, {3, 4, 8, 7}, {4, 1, 
    5, 8}, {5, 6, 7, 8}};
vtc = {{0, 0}, {1, 0}, {1, 1}, {0, 1}};

gr = Graphics3D[{Black, EdgeForm[Black],
   Table[{Texture[sides[[i]]], 
     GraphicsComplex[v, 
      Polygon[idx[[i]], VertexTextureCoordinates -> vtc]]}, {i, 6}]}, 
  Boxed -> False]

Show[gr, Graphics3D[{Red, Point[p = {-1, -.3, 0.2}]}], ViewPoint -> Left] 
colorAtPoint3DX[gr, p] (* color returned should be white *)

The red point only indicates the position of the point, not the color, it should return a color of white from the Texture of the cloud image.

To see this problem another way, this should recover the image on the Left side of the box, but it doesn't:

Grid@Table[colorAtPoint3DX[gr, {-1, y, z}], {y, -1, 1, .1}, {z, -1, 1, .1}]

A second problem is that it is too slow. It takes 10 seconds for 50 pts currently, and I need to do this for every point in the mesh (tens of thousands):

Table[colorAtPoint3DX[gr, 
   RandomPoint[Rectangle[{-1, -1}, {1, 1}]]~Join~{-1}], 
  50] // AbsoluteTiming

Response to Update #1:

I like your approach! But it doesn't seem to work with Texture, which is important to me:

As you can see the red point is on a cloud, so the color returned should be white. If you can update this answer to work on examples like this (with a textured polygon), I will accept it!

Answer 2

This question seems close related: can i get a list of rgb colors from a graphics object

For Image3D use ImageSlice:

Image3D[RandomReal[1, {5, 10, 10, 3}]]

Image3DSlices@Image3D[RandomReal[1, {5, 10, 10, 3}]]

pi = (Image3DSlices@Image3D[RandomReal[1, {5, 10, 10, 3}]])[2] (RGBColor[#]) & /@ (ImageData[ pi][[#[2], #[3]]] & /@ (Table[{RandomInteger[(Dimensions[ ImageData[pi]])[2]], RandomInteger[(Dimensions[ImageData[pi]])[3]]}, {16}]))

From this question work towards applying this to Graphics3D: slice through graphics3d

The only path for Graphics3D is over Export and ClipPlanes.

Answer 3

First, we can triangulate the polygon with texture index triangles[need's a program like Blender's subdivide, or other Mathematica codes, to subdivide VertexTextureCoordinates' polygon].

texture here is the texture Image.

size=First@ImageDimensions@texture;
AbsoluteTiming[colorList=ParallelTable[If[Mod[i,1000]==0,Print@i];
polygon=size*resList[[1]][[2]][[All,All,1;;2]][[i]];
ImageValue[texture,polygon],{i,num}];]

polygon above is the VertexTextureCoordinates polygon. resList is texture index triangles imported of obj File.

So we get polygons' vertexColors, then we use a method to obtain point color, for example Mean[colorList[[1]]].