3D Picking again
- To: mathgroup at smc.vnet.net
- Subject: [mg84685] 3D Picking again
- From: "Fred Klingener" <gigabitbucket at gmail.com>
- Date: Wed, 9 Jan 2008 03:53:01 -0500 (EST)
- Reply-to: "Fred Klingener" <gigabitbucket at gmail.com>
This is a follow-up to the 3D Locator thread. Here's a marginally legal Demonstration that shows a way to use a Pluecker pick line, defined by MousePosition["Graphics3DBoxIntercepts", on a random set of points in a Graphics3D. It avoids some of the flakier behavior of the examples I posted earlier by using With[ (cropped mostly from the Advanced Manipulate Functionality tutorial) instead of an EventHandler. AFAIC, it's just not worth the grief trying to get an EventHandler running inside a Manipulate. My reference for Pluecker lines is Shoemake's http://tog.acm.org/resources/RTNews/html/rtnv11n1.html#art3 (* 2008-01-08 Fred Klingener *) (* Mathematica 6.0.1 *) Manipulate[ Grid[{{Panel[ "These are two independent views of the same set of points, randomly \ distributed in space. Each view can be manipulated independently by mouse in \ the usual way. In either view, a 3D 'pick line' can be selected passing \ through the mouse pointer and perpendicular to the screen. The point closest \ to the pick line is highlighted. The pick line appears in both views, but is \ seen end on and therefore practically invisible in the pick view.", ImageSize -> {600, 130}], SpanFromLeft} , { Graphics3D[ {Dynamic[ With[ { iPts = MousePosition["Graphics3DBoxIntercepts", iPt0] } , {image = { Point[cloud] , {Red, Line[{{0, 0, 0}, {p[[1]], 0, 0}}]} , {Green, Line[{{p[[1]], 0, 0}, {p[[1]], p[[2]], 0}}]} , {Blue, Line[{{p[[1]], p[[2]], 0}, {p[[1]], p[[2]], p[[3]]}}]} , {Hue[0.9060679774997897, 0.6, 0.6], {Thick, Line[iPts]} , PointSize[0.05] , Dynamic@Point[ p = cloud[[ Position[ d0 = Table[ distanceLP[cloud[[i]], pLine[iPts[[1]], iPts[[2]]]], {i, nPoints}], Min@d0][[1, 1]]]]] } } , Text[ToString[p], p, {0, -2}] } ] (* With *) ] (* Dynamic *) }, opts = {PlotRange -> 1.5 , ImageSize -> 280 , Axes -> True , AxesLabel -> {"x", "y", "z"}} ] (* Graphics3D *) , Dynamic@Graphics3D[image, opts] } }] (* Grid *) , {n, Appearance -> None} , Initialization -> ( nPoints = 10; iPt0 = {{0.556581, -1.43647, 1.5}, {-1.14868, 1.5, -0.792715}}; cloud = Table[{RandomReal[{-1, 1}], RandomReal[{-1, 1}], RandomReal[{-1, 1}]} , {i, nPoints}]; (* Pluecker line from Q to P *) pLine[P_, Q_] := {P - Q, Q\[Cross]P}; (* vector from Pluecker line L to point P *) vectorLP[P_, L_] := Module[{U = L[[1]], V = L[[2]]}, U\[Cross](P\[Cross]U - V)/U.U]; (* distance between Pluecker line L and point P *) distanceLP[P_, L_] := Norm[vectorLP[P, L]]; ) ] (* Manipulate *) Hth, Fred