3
$\begingroup$

I want to control the point Q by a Locator not with Slider, how to make this work?

    Manipulate[
 DynamicModule[{Q, AB, angle, normAB , ThreePoints, fa, v1, v2, r},
  AB = OB - OA;
  normAB = If[Norm[AB] != 0, Norm[AB], 1];
  
  Q = OA + t AB;
  
  ThreePoints = {OP, Q, OA};
  v1 = ThreePoints[[1]] - ThreePoints[[2]];
  v2 = ThreePoints[[3]] - ThreePoints[[2]];
  fa[rd_List] := Arg[rd[[1]] + I rd[[2]]];
  angle = 
   If[fa[v2] > fa[v1], {fa[v1], fa[v2]}, {fa[v1], 2 Pi + fa[v2]}];
  If[angle[[2]] - angle[[1]] >= Pi, 
   angle = {angle[[2]], angle[[1]] + 2 Pi}];
  r = Min[Norm[v1], Norm[v2]]/3;
  
  Graphics[
   {Purple, PointSize[0.03], Point[Q],
    {Thickness[0.003], Black, InfiniteLine[{OA, OB}]},
    {Thickness[0.003], Black, Line[{Q, OP}]},
    Text[Style["A", 13], OA + 0.5 ({{0, -1}, {1, 0}} . AB)/normAB],
    Text[Style["B", 13], OB + 0.5 ( {{0, -1}, {1, 0}} . AB)/normAB],
    Text[Style["Q", FontSize -> 16, Purple], 
     Q + 0.5 ( {{0, -1}, {1, 0}} . AB)/normAB],
    Text[Style["P", FontSize -> 16, Purple], OP + 0.3 {1, 1}],
    Text[Style["drag the point Q until PQ makes an right 
angle with the line", FontSize -> 18, Black], {6, 6}],
    
    (* Plot circle and arrows for the angle *)
    RGBColor[.49, 0, 0], Circle[ThreePoints[[2]], r, angle], 
    Arrowheads[Medium],
    Arrow[{{ThreePoints[[2, 1]] + r Cos[angle[[2]]], 
       ThreePoints[[2, 2]] + r Sin[angle[[2]]]},
      {ThreePoints[[2, 1]] + r Cos[angle[[2]] + 0.0025], 
       ThreePoints[[2, 2]] + r Sin[angle[[2]] + 0.0025]}}], 
    Arrow[{{ThreePoints[[2, 1]] + r Cos[angle[[1]] + 0.0025], 
       ThreePoints[[2, 2]] + r Sin[angle[[1]] + 0.0025]},
      {ThreePoints[[2, 1]] + r Cos[angle[[1]]], 
       ThreePoints[[2, 2]] + r Sin[angle[[1]]]}}],
    
    (*plot the value of the angle*)
    Text[
     Style[NumberForm[
       N[(angle[[2]] - angle[[1]])/Pi*180] "°", {5, 2}], Bold, 14],
     {ThreePoints[[2, 1]] + 1.5* r Cos[Mean[angle]], 
      ThreePoints[[2, 2]] + 1.5* r Sin[Mean[angle]]}]
    },
   Axes -> True, AxesStyle -> Blue, 
   Ticks -> {Range[-10, 10, 1], Range[-10, 10, 1]}, 
   GridLines -> {Range[-10, 10, 1], Range[-10, 10, 1]}, 
   GridLinesStyle -> Dotted, PlotRange -> {{-2, 10}, {-4, 10}}, 
   ImageSize -> Large]
  ],
 
 {{OA, {8, -1}}, {-10, -10}, {10, 10}, Locator},
 {{OB, {2, 2}}, {-10, -10}, {10, 10}, Locator},
 {{OP, {6, 4}}, {-10, -10}, {10, 10}, Locator},
 {{t, 0.5, Style["Q", Bold, Purple, 18]}, -3, 3, 0.01, Slider}
 ]

This is the graph right now, How to control point Q by a Locator? Like the other points? I'm new to Mathematica, And I have tried many things but none worked! thanks for helping! the graph

Improve this question
$\endgroup$

2 Answers 2

Reset to default
4
$\begingroup$

Declare Q to be a locator and add a statement that forces Q to be on the line A to B and delete Q from the list of local variables.

Here is the changed code:

Manipulate[
 DynamicModule[{AB, angle, normAB, ThreePoints, fa, v1, v2, r}, 
  AB = OB - OA;
  normAB = If[Norm[AB] != 0, Norm[AB], 1];
  (*Q=OA+t AB;*)
  Q = OA + ((Q - OA) . AB/normAB)  AB/normAB;
  ThreePoints = {OP, Q, OA};
  v1 = ThreePoints[[1]] - ThreePoints[[2]];
  v2 = ThreePoints[[3]] - ThreePoints[[2]];
  fa[rd_List] := Arg[rd[[1]] + I rd[[2]]];
  angle = 
   If[fa[v2] > fa[v1], {fa[v1], fa[v2]}, {fa[v1], 2 Pi + fa[v2]}];
  If[angle[[2]] - angle[[1]] >= Pi, 
   angle = {angle[[2]], angle[[1]] + 2 Pi}];
  r = Min[Norm[v1], Norm[v2]]/3;
  Graphics[{Purple, PointSize[0.03], 
    Point[Q], {Thickness[0.003], Black, 
     InfiniteLine[{OA, OB}]}, {Thickness[0.003], Black, 
     Line[{Q, OP}]}, 
    Text[Style["A", 13], OA + 0.5 ({{0, -1}, {1, 0}} . AB)/normAB], 
    Text[Style["B", 13], OB + 0.5 ({{0, -1}, {1, 0}} . AB)/normAB], 
    Text[Style["Q", FontSize -> 16, Purple], 
     Q + 0.5 ({{0, -1}, {1, 0}} . AB)/normAB], 
    Text[Style["P", FontSize -> 16, Purple], OP + 0.3 {1, 1}], 
    Text[Style["drag the point Q until PQ makes an right 
angle with the line", FontSize -> 18, Black], {6, 
      6}],(*Plot circle and arrows for the angle*)RGBColor[.49, 0, 0],
     Circle[ThreePoints[[2]], r, angle], Arrowheads[Medium], 
    Arrow[{{ThreePoints[[2, 1]] + r Cos[angle[[2]]], 
       ThreePoints[[2, 2]] + 
        r Sin[angle[[2]]]}, {ThreePoints[[2, 1]] + 
        r Cos[angle[[2]] + 0.0025], 
       ThreePoints[[2, 2]] + r Sin[angle[[2]] + 0.0025]}}], 
    Arrow[{{ThreePoints[[2, 1]] + r Cos[angle[[1]] + 0.0025], 
       ThreePoints[[2, 2]] + 
        r Sin[angle[[1]] + 0.0025]}, {ThreePoints[[2, 1]] + 
        r Cos[angle[[1]]], 
       ThreePoints[[2, 2]] + 
        r Sin[angle[[1]]]}}],(*plot the value of the angle*)
    Text[Style[
      NumberForm[N[(angle[[2]] - angle[[1]])/Pi*180] "°", {5, 2}], 
      Bold, 14], {ThreePoints[[2, 1]] + 1.5*r Cos[Mean[angle]], 
      ThreePoints[[2, 2]] + 1.5*r Sin[Mean[angle]]}]}, Axes -> True, 
   AxesStyle -> Blue, Ticks -> {Range[-10, 10, 1], Range[-10, 10, 1]},
    GridLines -> {Range[-10, 10, 1], Range[-10, 10, 1]}, 
   GridLinesStyle -> Dotted, PlotRange -> {{-2, 10}, {-4, 10}}, 
   ImageSize -> Large]], {{OA, {8, -1}}, {-10, -10}, {10, 10}, 
  Locator}, {{OB, {2, 2}}, {-10, -10}, {10, 10}, 
  Locator}, {{OP, {6, 4}}, {-10, -10}, {10, 10

}, Locator},
 {{Q, {4, 2}}, {-10, -10}, {10, 10}, Locator}]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ Hi, first thanks for the answer and this is working! but I don't understand this line of code where Q = OA + ((Q - OA) . AB/normAB) AB/normAB; how you can put Q in the right side of the equation when its not declared yet? $\endgroup$
    – Tt Tt
    Sep 4, 2022 at 6:07
  • $\begingroup$ It is already declared and has a value by: {{Q, {4, 2}}, {-10, -10}, {10, 10}, Locator} $\endgroup$
    – Daniel Huber
    Sep 4, 2022 at 7:31
2
$\begingroup$

This seems a trivial fix. Not certain if you have have a larger question.

Essentially, just change:

{{t, 0.5, Style["Q", Bold, Purple, 18]}, -3, 3, 0.01, Slider}

to

{{t, 0.5, Style["Q", Bold, Purple, 18]}, -3, 3, 0.01, Locator}

More completely...

Manipulate[
 DynamicModule[{Q, AB, angle, normAB, ThreePoints, fa, v1, v2, r}, 
  AB = OB - OA;
  normAB = If[Norm[AB] != 0, Norm[AB], 1];
  Q = OA + t AB;
  ThreePoints = {OP, Q, OA};
  v1 = ThreePoints[[1]] - ThreePoints[[2]];
  v2 = ThreePoints[[3]] - ThreePoints[[2]];
  fa[rd_List] := Arg[rd[[1]] + I rd[[2]]];
  angle = 
   If[fa[v2] > fa[v1], {fa[v1], fa[v2]}, {fa[v1], 2 Pi + fa[v2]}];
  If[angle[[2]] - angle[[1]] >= Pi, 
   angle = {angle[[2]], angle[[1]] + 2 Pi}];
  r = Min[Norm[v1], Norm[v2]]/3;
  Graphics[{Purple, PointSize[0.03], 
    Point[Q], {Thickness[0.003], Black, 
     InfiniteLine[{OA, OB}]}, {Thickness[0.003], Black, 
     Line[{Q, OP}]}, 
    Text[Style["A", 13], OA + 0.5 ({{0, -1}, {1, 0}} . AB)/normAB], 
    Text[Style["B", 13], OB + 0.5 ({{0, -1}, {1, 0}} . AB)/normAB], 
    Text[Style["Q", FontSize -> 16, Purple], 
     Q + 0.5 ({{0, -1}, {1, 0}} . AB)/normAB], 
    Text[Style["P", FontSize -> 16, Purple], OP + 0.3 {1, 1}], 
    Text[Style["drag the point Q until PQ makes an right 
angle with the line", FontSize -> 18, Black], {6, 
      6}],(*Plot circle and arrows for the angle*)RGBColor[.49, 0, 0],
     Circle[ThreePoints[[2]], r, angle], Arrowheads[Medium], 
    Arrow[{{ThreePoints[[2, 1]] + r Cos[angle[[2]]], 
       ThreePoints[[2, 2]] + 
        r Sin[angle[[2]]]}, {ThreePoints[[2, 1]] + 
        r Cos[angle[[2]] + 0.0025], 
       ThreePoints[[2, 2]] + r Sin[angle[[2]] + 0.0025]}}], 
    Arrow[{{ThreePoints[[2, 1]] + r Cos[angle[[1]] + 0.0025], 
       ThreePoints[[2, 2]] + 
        r Sin[angle[[1]] + 0.0025]}, {ThreePoints[[2, 1]] + 
        r Cos[angle[[1]]], 
       ThreePoints[[2, 2]] + 
        r Sin[angle[[1]]]}}],(*plot the value of the angle*)
    Text[
     Style[
      NumberForm[
       N[(angle[[2]] - angle[[1]])/Pi*180] "\[Degree]", {5, 2}], Bold,
       14], {ThreePoints[[2, 1]] + 1.5*r Cos[Mean[angle]], 
      ThreePoints[[2, 2]] + 1.5*r Sin[Mean[angle]]}]}, Axes -> True, 
   AxesStyle -> Blue, Ticks -> {Range[-10, 10, 1], Range[-10, 10, 1]},
    GridLines -> {Range[-10, 10, 1], Range[-10, 10, 1]}, 
   GridLinesStyle -> Dotted, PlotRange -> {{-2, 10}, {-4, 10}}, 
   ImageSize -> Large]],
 {{OA, {8, -1}}, {-10, -10}, {10, 10}, Locator},
 {{OB, {2, 2}}, {-10, -10}, {10, 10}, Locator},
 {{OP, {6, 4}}, {-10, -10}, {10, 10}, Locator},
 {{t, 0.5, Style["Q", Bold, Purple, 18]}, -3, 3, 0.01, Locator}]
Improve this answer
$\endgroup$
1
  • $\begingroup$ Thanks for the answer but this doesn't work ! $\endgroup$
    – Tt Tt
    Sep 4, 2022 at 6:15

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.