11
$\begingroup$

A closed surface consisted of Polygons or GraphicsComplex and a triangle made by 3 points are in a 3D space. How can I decide whether intersected or not. I have tried by using RegionMember but It does not work. (this code is typed in version 10)

g1 = RevolutionPlot3D[{2 + Cos[t], Sin[t]}, {t, 0, 2 Pi},
   PlotPoints -> 2];
surface = 
  GraphicsComplex[g1[[1, 1]], {Opacity[0.7], g1[[1, 2, 1, 1, 5, 1]]}];

triangles = {
   Polygon[{{0, 0, 0}, {0, 2, 2}, {0, -1, 2}}],
   Polygon[{{2, 0, 0}, {2, 2, 2}, {2, -1, 2}}],
   Polygon[{{-3, 0, -3}, {3, 2, 2}, {-3, -1, 2}}]};

examples

Grid[{{"Not Intersected", "Inside 1-Point,
   Intersected", "Outside 3-Point,
   Intersected"},
  Table[Graphics3D[{surface, Opacity[0.7], Green, t},
    Boxed -> False], {t, triangles}]}, Frame -> All]

Mathematica graphics

I want to make a function that is decide whether intesected or not like this:

enter image description here

I expect like this results.

enter image description here

Is there any idea or algorithm paper?


My Wrong Try

makeSurfaceEq[v_List, {x_, y_, z_}] :=
 Module[{a, b, c, d, eq},
   eq = a x + b y + c z + d == 0;
   eq = eq /. NSolve[(a #1 + b #2 + c #3 + d == 0 &) @@@ v];
   eq = If[eq[[0]] === List, eq[[1]]];
   eq /. {a | b | c | d -> 1}
   ] /; Length[v] >= 3
polygonToSurfaceInEq[v_, f_, {x_, y_, z_}] := Module[{cOfG, eqs, ineq},
  cOfG = Mean@v;
  eqs = makeSurfaceEq[v[[#]], {x, y, z}] & /@ f;
  Table[
    ineq = eqs[[i]] /. Equal -> Greater;
    If[ineq /. Thread[{x, y, z} -> cOfG], ineq, ! ineq],
    {i, Length[eqs]}] /.
   {Greater -> GreaterEqual, Less -> LessEqual}
  ]

here is something wrong result. and though a point is in closed surface, the command

polygonToSurfaceInEq

is not applied for a like torus.

intersectedQ[polygons_, triangle_] := Module[{},
  f = Function @@ {{x, y, z},
     And @@ polygonToSurfaceInEq[
       polygons[[1]],
       Cases[polygons, Polygon[a_] -> a, \[Infinity]][[1]],
       {x, y, z}]
     };
  Or @@ f @@@ triangle[[1]]
  ]

my try is this.

intersectedQ[surface, triangles[[1]]]

True

3 points are all outside of the surface.

intersectedQ[surface, triangles[[2]]]

False


Wrong Try2 Pickett's answer is good approach but is not a answer of my question. The closed surface is made by polygons and bounded by polygons surfaces. The following example show that I mean.

intersectQ[polygon_] := With[{distFunc = RegionDistance@Polygon[polygon]}, 
   Length@Select[
      findPossibleIntersections[polygon, surface[[1]], 0.01], 
      distFunc@# < 0.05 &] > 0];
intersectQ@{{1.8, 1.2, 0.9}, {1.5, 1, 2}, {1.5, 2, 2}}

False

This is inside of surface, but this code answer FALSE.

Graphics3D[{surface,
  Opacity[.7], Green, 
  Polygon[{{1.8, 1.2, 0.9}, {1.5, 1, 2}, {1.5, 2, 2}}],
  Opacity[1], Red, Point[{1.8, 1.2, 0.9}]},
 Boxed -> False]

enter image description here

$\endgroup$
  • $\begingroup$ thanks Oska for considering my question. $\endgroup$ – Junho Lee Aug 16 '14 at 20:28
  • $\begingroup$ RegionIntersection is supposed to do this but it doesn't work for regions embedded in 3D. $\endgroup$ – RunnyKine Aug 16 '14 at 20:34
  • $\begingroup$ @RunnyKine yes I know about that. I need in 3d $\endgroup$ – Junho Lee Aug 16 '14 at 20:45
4
$\begingroup$

Here is a way to do it:

g1 = RevolutionPlot3D[{2 + Cos[t], Sin[t]}, {t, 0, 2 Pi}, 
   PlotPoints -> 2];
surface = 
  GraphicsComplex[g1[[1, 1]], {Opacity[0.7], g1[[1, 2, 1, 1, 5, 1]]}];

triangles = {Polygon[{{0, 0, 0}, {0, 2, 2}, {0, -1, 2}}], 
   Polygon[{{2, 0, 0}, {2, 2, 2}, {2, -1, 2}}], 
   Polygon[{{-3, 0, -3}, {3, 2, 2}, {-3, -1, 2}}],
   Polygon[{{1.8, 1.2, 0.9}, {1.5, 1, 2}, {1.5, 2, 2}}]
   };

First we extract and partition the coordinates and polygons.

coords = surface[[1]];
ply = Flatten[
   Cases[surface[[2]], _Polygon, Infinity] /. 
    Polygon[data_] :> Partition[data, 1], 1];

Load TetGenLink

Needs["TetGenLink`"]

and write a test function that returns a Graphics3D with the intersection. It should be easy to adjust this.

test[in_] := Module[{nc, maxInci, ninci, res},
  nc = getCoords[in];
  maxInci = Max[ply];
  ninci = {{Range[Length[nc]]}} + maxInci;
  res = TetGenDetectIntersectingFacets[Join[coords, nc], 
    Join[ply, ninci]];
  Graphics3D[GraphicsComplex[res[[1]], Polygon[res[[2]]]]]
  ]

getCoords[Polygon[d_]] := N[d];

When I run this on your example

test /@ triangles

enter image description here enter image description here enter image description here enter image description here

$\endgroup$
  • $\begingroup$ @Öskå, you could Show the graphics together. $\endgroup$ – user21 Aug 17 '14 at 14:32
  • $\begingroup$ @user21 Thank you This is very interesting of TetGenLink`. $\endgroup$ – Junho Lee Aug 17 '14 at 14:33
1
$\begingroup$

First step is turning the GraphicsComplex in surface into standard Polygon-s:

polys = surface // Normal // Flatten;

I'll be using Resolve further on which doesn't like inaccurate numbers, so I Rationalize the coordinates. There are many coordinates that are terribly close to each other, leading to degenerated polygons. I'll remove these:

polysClean =  
   DeleteCases[Map[Union[Rationalize[#, .00001]] &, polys, {2}], Polygon[a_] /; Length[a] < 3] 

Introduce a function that describes a general point on a triangle:

triPoint[poly_List, m_, n_] :=
    Module[{l1},
      l1 = m (poly[[3]] - poly[[2]]) + poly[[2]];
      n (l1 - poly[[1]]) + poly[[1]]
]

A point is within the triangle if 0 <= n <= 1 && 0 <= m <= 1. We can now use Resolve and Exists to find out whether there are surface triangles for which such a general point exists on the test triangle that makes it a RegionMember of the surface triangle:

intersectionQ[polys_, testPoly_] :=
Or @@ 
(Resolve[
   Exists[{n, m}, 
      0 <= n <= 1 && 0 <= m <= 1 && RegionMember[#, triPoint[testPoly, m, n]]
   ]
 ] & /@  polys)

intersectionQ[polysClean, #] & /@ First /@ triangles
(* {False, True, True} *)

By the way, if the torus was defined implicitly, using ImplicitRegion it would all be much more easy and faster:

ℛ = ImplicitRegion[1 <= Sqrt[x^2 + y^2] <= 3 && (Sqrt[x^2 + y^2] - 2)^2 + z^2 <= 1, {x, y, z}]

Resolve[Exists[{n, m}, 0 <= n <= 1 && 0 <= m <= 1 && 
   RegionMember[ℛ, triPoint[{{2, 0, 0}, {2, 2, 2}, {2, -1, 2}}, m, n]]]]
(* True *)
$\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.