Skip to main content

computational geometry - Graphics3D: Finding intersection of 3d objects and lines


I found these two nice links 1) intersecting graphics 2) Implementation of Balaban's Line intersection algorithm in Mathematica which works for 2d.


However, I need to find whether a ray(line) intersects with a 3d object (it can be the bounding box np) and count how many of the lines intersect with a particular object.


The code so far


gr1 = Graphics3D[{

Green,
Polygon[{{-10, -15, 0}, {-10, 10, 0}, {10, 10, 0}, {10, -15, 0}}],
}];
gr2 = Graphics3D[{
Yellow, Cylinder[{{4, 0, 3}, {4, 0, 6}}],
Red, Sphere[{6, 5, 2}, 2],
Blue, Cuboid[{-2, -1, 0}, {2, 2, 2}],
Blue, Cuboid[{-6, -2, 0}, {-3, 2, 4}]
}];


grR = Graphics3D[
Line[{{0, -10, 2}, #}] & /@ RandomReal[{-5, 10}, {50, 3}]];
Show[gr1, gr2, grR]

the scene


Question


What is an efficient way of finding intersections in 3d and counting based on the objects.


Some useful links for people who might be interested. In computer graphics the subject falls under 'Line clipping'




Answer




I will use a slightly different example to demonstrate my method (which is in no way guaranteed to solve the problem perfect but just an approach).


Firt we generate $100$ random cuboids with unique color for each of them, so we can have a bijection colorToIdxRules between the color set colorSet and the indice of the cuboids


numObj = 100; numRay = 50;

colorSet = Hue[#, .3, 1] & /@ RandomReal[{0, 1}, numObj];

colorToIdxRules =
MapIndexed[ImageData[Rasterize[Graphics3D[{#1, Sphere[]}, Lighting -> {{"Ambient",White}},
Boxed -> False, ImageSize -> 40]], "Byte"][[20, 20]] -> #2[[1]] &, colorSet]


posObj = RandomReal[5 {-1, 1}, {numObj, 3}] /.
pt_List /; NumericQ[pt[[1]]] :> {pt, pt + RandomReal[5 {-1, 1}, 3]};

grObj = Flatten[ MapThread[
{EdgeForm[Lighter[#1]], FaceForm[#1], Cuboid @@ #2} &,
{colorSet, posObj}]];

and $50$ rays start from the same point ptOrig and with their endpoints stored in ptEndSet.


ptOrig = {0, 0, 0};
ptEndSet = RandomReal[{-10, 10}, {numRay, 3}];

grR = Line[{ptOrig, #}] & /@ ptEndSet;

Graphics3D[{grObj, grR}, Axes -> True,
AxesLabel -> (Style[#, Bold, Darker[Blue], 20] & /@ {x, y, z}),
Lighting -> "Neutral"]

full graphics


For solving the problem, the idea is to travel along a ray, say the 1st one in ptEndSet, with using PlotRange to restrict the considering region as local as possible, so iff this ray intersects a surface, otherwise we won't see the surface during the whole journey.


Manipulate[
Graphics3D[{GeometricTransformation[

{grObj, grR, Red, Thick, Line[{ptOrig, ptEndSet[[k]]}]},
RotationTransform[{ptEndSet[[k]] - ptOrig, {0, 0, 1}}, ptOrig]
]},
Axes -> True,
AxesLabel -> (Style[#, Bold, Darker[Blue], 20] & /@ {x, y, z}),
Lighting -> "Neutral"],
{k, 1, Length@ptEndSet, 1}]

ray aligned to z


With[{k = 1},

With[{zrangeFull = (RotationTransform[{ptEndSet[[k]] - ptOrig, {0, 0, 1}}, ptOrig] /@
{ptOrig, ptEndSet[[k]]})[[All, 3]]},
Manipulate[
Graphics3D[{GeometricTransformation[
{grObj, grR, Red, Thick, Line[{ptOrig, ptEndSet[[k]]}]},
RotationTransform[{ptEndSet[[k]] - ptOrig, {0, 0, 1}}, ptOrig]
]},
Axes -> True,
AxesLabel -> (Style[#, Bold, Darker[Blue], 20] & /@ {x, y, z}),
Lighting -> "Neutral",

PlotRange -> {ptOrig[[1]] + δ {-1, 1},
ptOrig[[2]] + δ {-1, 1}, zrange + δ {-1, 1}}],
{{zrange, 2.356`}, zrangeFull[[1]], zrangeFull[[2]]},
{{δ, 0.01`}, 0.01, 10, .01}
]]]

neighborhood region


For sake of higher efficiency, we don't really travel along it. Instead, we consider a cylindrical neighbourhood of the ray, with a special view setting (an approximate orthogonal projection, I'm not sure how to use ViewMatrix to realize an exactly orthogonal projection for this plot.. Settings from here seems behave weird on my plot..), and then Rasterize it:


SetOptions[$FrontEnd, 
RenderingOptions -> {"HardwareAntialiasingQuality" -> 0.}]


With[{k = 1, δ = 10^-4, vp = 10^10},
With[{zrangeFull = (RotationTransform[{ptEndSet[[k]] - ptOrig, {0, 0, 1}}, ptOrig] /@
{ptOrig, ptEndSet[[k]]})[[All, 3]]},
img = Graphics3D[{EdgeForm[], GeometricTransformation[
grObj /. EdgeForm[_] :> EdgeForm[],
RotationTransform[{ptEndSet[[k]] - ptOrig, {0, 0, 1}}, ptOrig]
]},
Lighting -> {{"Ambient", White}},
ViewPoint -> vp {0, 1, -10^-2}, ViewVertical -> {1, 0, 0},

Boxed -> False, BoxRatios -> {1, 1, 10},
PlotRange -> {ptOrig[[1]] + δ {-1, 1}, ptOrig[[2]] + δ {-1, 1}, zrangeFull},
ImageSize -> 2000] // Rasterize // ImageCrop
]]

color spectrum


Finally we extract colors of the surfaces presented, from left to right, which is according with the direction of the ray:


SetOptions[$FrontEnd, 
RenderingOptions -> {"HardwareAntialiasingQuality" -> 1.}]


DeleteCases[Union[#][[1]] & /@
Split[ImageData[img, "Byte"][[
Round[ImageDimensions[img][[2]]/20]
]]],
{255, 255, 255}] /. colorToIdxRules


{45, 73, 45, 73, 30, 30, 61, 41, 75, 75, 61, 41}



So from ptOrig to its endpoint in ptEndSet, this ray intersects successively with the 45th, 73rd, 45th again, ... cuboids.





Here I packed the code above to a function crossObjFunc:


Clear[crossObjFunc]
crossObjFunc[grObj_, ptOrig_, ptEnd_, OptionsPattern["showImg" -> False]] :=
Module[{img, zrangeFull,
δ = 10^-4, vp = 10^10, δz = 10^-2, imgSize = 2000, boxRat = 10},
SetOptions[$FrontEnd, RenderingOptions -> {"HardwareAntialiasingQuality" -> 0.}];
zrangeFull = (RotationTransform[{ptEnd - ptOrig, {0, 0, 1}}, ptOrig] /@
{ptOrig, ptEnd})[[All, 3]];
img = Graphics3D[{EdgeForm[], GeometricTransformation[

grObj /. EdgeForm[_] :> EdgeForm[],
RotationTransform[{ptEnd - ptOrig, {0, 0, 1}}, ptOrig]
]},
Lighting -> {{"Ambient", White}},
ViewPoint -> vp {0, 1, -δz}, ViewVertical -> {1, 0, 0},
Boxed -> False, BoxRatios -> {1, 1, boxRat},
PlotRange -> {ptOrig[[1]] + δ {-1, 1}, ptOrig[[2]] + δ {-1, 1}, zrangeFull},
ImageSize -> imgSize] // Rasterize // ImageCrop;
If[OptionValue["showImg"], Print[img]];
SetOptions[$FrontEnd, RenderingOptions -> {"HardwareAntialiasingQuality" -> 1.}];

DeleteCases[Union[#][[1]] & /@
Split[ImageData[img, "Byte"][[
Round[ImageDimensions[img][[2]]/(2 boxRat)]
]]],
{255, 255, 255}, ∞] /. colorToIdxRules]

crossObjFunc[grObj, ptOrig, ptEndSet[[1]], "showImg" -> True]


(Graphics omitted)



{42, 42, 61, 41}



It will take about 25 seconds for parsing all the rays on my desktop PC with a 2.4G CPU and 8G RAM:


AbsoluteTiming[crossSet = crossObjFunc[grObj, ptOrig, #] & /@ ptEndSet;][[1]]


25.542461



A summary for all rays:


summary





Disadvantage: When placing the 3D graphics to get a side view, there is possibility that two surfaces close enough will cover one another. And also possibility that for some special directed surface, the viewpoint is almost on its tangent plane, so its profile would be too thin to be captured by Rasterize thus will be missed.


miss surface


Problem remain: When there are alpha channel in colorSet, I currently can't figure out how to construct a proper map to the index. Transparent 3D objects are converted to non-transparent raster image, with their colors more or less changed.


Comments

Popular posts from this blog

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...