Defining a polygon by clicking on an image [duplicate]

Imagine I have some image, $I$, and I'd like to define a polygon by sequentially clicking on the image to define vertices $(v_1, ...) \in V$, where vertices $v_i$ and $v_j$ share an edge if $j = (i+1)$. I'd like to end the vertex selection process by right clicking, or hitting something on the keypad - really anything that's convenient. I suppose I'd like the $v_i$ to be specified in terms of image coordinates vs. image indices (if possible).

Is there a straightforward way to do this in Mathematica 9.0?

-

marked as duplicate by R. M.♦Jul 27 '13 at 4:18

Duplicate: mathematica.stackexchange.com/q/3566/5 – R. M. Jul 27 '13 at 3:09
@Nasser Ahhh shoot, I'm sorry, I didn't look around carefully enough. >_< – Sparse Pine Jul 27 '13 at 3:33

Just a quick start, to see if this is what you want. Can easily extend/clean up. To start a new polygon now or clean the old one, need to re-evaluate, just back of the envelope thing, to see first if this is what you wanted...

pt = {0, 0};
pts = {pt};
ClickPane[
Dynamic[Graphics[{
{Yellow, Disk[]},
{Black, Point[pt]},
{Red, Line[pts]}
}, ImageSize -> Tiny]], (pt = #; AppendTo[pts, pt]) &]


and if you want to use an Image:

pt = {0, 0};
pts = {pt};
img = Import["ExampleData/lena.tif"];
Framed@Grid[{
{
ClickPane[
Dynamic[
Show[Image[img, ImageSize -> 200],
Graphics[{
{Red, PointSize[Large], Point[pt]},
{Thick, White, Line[pts]}
}, ImageSize -> Tiny]]], (pt = #; AppendTo[pts, pt]) &]
},
{Dynamic[pt]}
}
]


-
How would I define the first point by clicking only? – Sparse Pine Jul 27 '13 at 3:49

Here's a way using Manipulate:

img = Import["ExampleData/lena.tif"];
create = True; color = White;
Manipulate[uS = u;
If[Length[uS] > 1 && Norm[uS[[-1]] - uS[[1]]] < 5, create = False;  color = Red;];
Show[img, Graphics[{color, Line[u]}, PlotRange -> 2]],
{{u, {{0, 0}}}, Locator, LocatorAutoCreate -> Dynamic[create]}]


In this implementation, you can use the locators to draw white lines. Add new locators by command-clicking. As soon as the final locator gets close enough (arbitrarily chosen to be "5" pixels) then the polygon turns red and the addition of new locators is suppressed.

-

In addition to Nasser's very nice answer, one can also slightly modify the answer of Heiki from the link rm -rf posted: Interactively extract points from a plot (ListPlot or SmoothDensityHistogram) with a button that returns the vertices of the drawn polytope:

points = RandomSample[Transpose[{Flatten[{RandomReal[{0, 5}, 20], RandomReal[{4, 4.5}, 10]}], Flatten[{RandomReal[1, 20], RandomReal[{1.5, 2}, 10]}]}], 30];

winding[poly_, pt_] := Round[(Total@Mod[(# - RotateRight[#]) &@(ArcTan @@ (pt - #) & /@ poly), 2 Pi, -Pi]/2/Pi)]

DynamicModule[{pl, pos}, pl = ListPlot[points, ColorFunction -> "TemperatureMap", ImageSize -> {850, 850}];
Manipulate[pos = Pick[Range[Length[points]], Unitize[winding[poly, #] & /@ points], 1];
Show[pl, Epilog -> {{Darker[Green], PointSize[Medium], Point[points[[pos]]]}, {Black, Point[Complement[points, points[[pos]]]]}, {EdgeForm[{Red, Dashed}], FaceForm[],Polygon[poly]}}], {{poly, {}}, Locator, LocatorAutoCreate -> All}, Row[{Button["Copy Points", Print[pos]], Button["Get Polytope Vertices", Print[poly]], Button["Reset", poly = {}; pos = {}]}]]]

-