12
$\begingroup$

Background: suppose I start with the following (working) snippet.

 Manipulate[Graphics[Line[{{0, 0}, p}], PlotRange -> 2], {{p, {1, 1}}, Locator}]

Ideally, I would like to be able to add points with their own locator to the graphic and via selecting or otherwise add Polygons, Circles, BezierCurves, etc.

Question: How can I interactively add a point to a Graphic that can be moved via its own locator? How can I select three or more points on such a Graphic and create a Polygon from them? ( I need the coordinates from the points, and which geometries have been created for later usage. )

* UPDATE* Thanks to FJRA's answer ( LocatorAutoCreate ) I can now rephrase the question as follows. From the following snippet

 Manipulate[
  Graphics[Map[Point[#] &, pts], 
   PlotRange -> 1], {{pts, {{0, 0}, {.5, 0}, {0, .5}}}, Locator, 
   LocatorAutoCreate -> True}]

Question: How can I select multiple points and create a polygon from them. Ideally, I would like to select a geometry: i.e. Circle, Polygon, BezierCurve.

$\endgroup$

2 Answers 2

23
$\begingroup$

This isn't exactly what you asked for, but it might do the trick. This solution allows you to create a number of different shapes (circle, polygon, line, Bezier curve, etc.). To add a shape, press the "New object" button. You can add points to an existing shape by clicking anywhere in the plane.

Note that I'm using LocatorAutoCreate -> All instead of True which means that you don't need a modifier key to add points. Deleting locators is the same as with LocatorAutoCreate -> True.

You can edit an existing object by pressing the "Edit object" button and choosing the right object. The "Print shapes" button prints a list of the shapes where each shape is represented by a list of coordinates and a string indicating the type.

DynamicModule[{types, fun},
 types = {"Circle", "Disk", "Polygon", "Line", "Bezier", "Spline"};
 fun[{}, ___] := {};
 fun[{a_}, ___] := {};
 fun[pts_, type_] := Switch[type,
   "Circle", Circle[pts[[1]], Norm[pts[[2]] - pts[[1]]]],
   "Disk", Disk[pts[[1]], Norm[pts[[2]] - pts[[1]]]],
   "Polygon", {EdgeForm[Black], FaceForm[Opacity[.5]], Polygon[pts]},
   "Line", Line[pts],
   "Bezier", BezierCurve[pts],
   "Spline", BSplineCurve[pts]];

 Manipulate[
  ptlst[[object]] = pts;
  typelst[[object]] = type;
  grlst = MapThread[fun, {ptlst, typelst}];
  Graphics[grlst, PlotRange -> {{-3, 3}, {-3, 3}}],

  {{pts, {}}, Locator, LocatorAutoCreate -> All},
  {{ptlst, {{}}}, None},
  {{typelst, {"Line"}}, None},
  {{object, 1}, None},
  {grlst, None},
  {{type, "Line", "Object type"}, types},
  Row[{Button["New object",
     If[Length[ptlst[[-1]]] > 0,
      AppendTo[ptlst, {}]; AppendTo[typelst, type];
      object = Length[typelst];
      pts = {}]],
    Dynamic@PopupView[Graphics[#, ImageSize -> 50] & /@ grlst,
      Dynamic[object, (object = #; pts = ptlst[[#]]; type = typelst[[#]]) &],
       Button["Edit object"]],
    Button["Print shapes", Print[Transpose[{ptlst, typelst}]]]}]
  ]]

Mathematica graphics

$\endgroup$
3
  • $\begingroup$ I did not think it was possible without J/Link stuff - Functionally, it is very close to what I had in mind. I have to integrate it with other code and so on, but that should be doable with this as a start. - Thank you, Heike. $\endgroup$ Commented Apr 12, 2012 at 14:53
  • 1
    $\begingroup$ And all that without one EventHandler, what a gem of Mma code! $\endgroup$ Commented Apr 14, 2012 at 7:26
  • $\begingroup$ After nearly seven years and a now a bit rusty on the subject I found an answer to what was my own question back then! $\endgroup$ Commented Jan 21, 2019 at 14:40
7
$\begingroup$

Maybe option LocatorAutoCreate -> True is what you need, it is documented in the help. This is the example shown in the Manipulate tutorial:

Manipulate[Graphics[Polygon[pts], PlotRange -> 1],
 {{pts, {{0, 0}, {.5, 0}, {0, .5}}}, Locator, 
  LocatorAutoCreate -> True}]

what they don't say in the docs is that for adding a point in linux you need to press Ctrl + Alt + click.

UPDATE:

Maybe you can add an extra control to select the graphics object you want to see:

    Manipulate[
     Graphics[g[pts], PlotRange -> 1],
     {g, {Point, Line, Polygon, BSplineCurve, BezierCurve}, ControlType -> PopupMenu},
     {{pts, {{0, 0}, {.5, 0}, {0, .5}}}, Locator, LocatorAutoCreate -> True}]
$\endgroup$
4
  • $\begingroup$ That is a start, anyway. From there on I must be able to delete points ( is that possible? ), group them and then create a Polygon from them, or another geometry and store the points and the geometries. $\endgroup$ Commented Apr 12, 2012 at 13:33
  • 1
    $\begingroup$ @ndroock1 You can delete points by clicking on one with the Ctrl+Alt keys pressed (same shortcut as adding a point, actually)… $\endgroup$
    – F'x
    Commented Apr 12, 2012 at 13:35
  • $\begingroup$ Thanks, I will update my question now based on your input. $\endgroup$ Commented Apr 12, 2012 at 13:38
  • $\begingroup$ Just for completeness, under OS X you need to press Cmd+click to add/delete locators $\endgroup$
    – Heike
    Commented Apr 12, 2012 at 13:38

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.