cvgmt
• 45.6k
• 3
• 30
• 66
Clear["Global*"];
pts = {{0., 0.}, {10., 0.}, {5., 8.}, {1., 6.}} // Rationalize;Map@N //
Rationalize[#, 0] &;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions =
Exists[{x1, y1, x2,
y2}, {x1, y1} ∈ reg && {x2, y2} ∈
reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2,
x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
plot = RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 80,
MaxRecursion -> 4, Prolog -> {EdgeForm[Cyan], FaceForm[], reg}];
domain = DiscretizeGraphics[plot];
nearest = RegionNearest@domain;
pt0 = {x, y} /. FindInstance[results, {x, y}][[1]];
fig[pt_] :=
Module[{instance, vector},
instance =
FindInstance[{RegionWithin[reg, Line[{pt - {u, v}, pt + {u, v}}]],
u^2 + v^2 >= (L/2)^2}, {u, v}];
vector = If[instance =!= {}, instance[[1]], {u -> 1, v -> 0}];
Show[plot,
Graphics[{Red, AbsolutePointSize[5], Point[pt],
Arrow[{pt, pt - L/2 Normalize@{u, v}}],
Arrow[{pt, pt + L/2 Normalize@{u, v}}]} /. vector,
PlotRange -> {{0, 10}, {0, 10}}]]];
Manipulate[
fig[pt], {{pt, pt0}, Locator,
TrackingFunction -> {pt = nearest@#; &}}, SaveDefinitions -> True]

deleted 11 characters in body
cvgmt
• 45.6k
• 3
• 30
• 66
Clear["Global*"];
pts = {{0., 0.}, {10., 0.}, {5., 8.}, {1., 6.}} // Rationalize;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions =
Exists[{x1, y1, x2,
y2}, {x1, y1} ∈ reg && {x2, y2} ∈
reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2,
x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
plot = RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 80,
MaxRecursion -> 4, Prolog -> {EdgeForm[Cyan], FaceForm[], reg}];
domain = DiscretizeGraphics[plot];
nearest = RegionNearest@domain;
pt0 = {x, y} /. FindInstance[results, {x, y}][[1]];
fig[pt_] :=
Module[{instance, vector},
instance =
FindInstance[{RegionWithin[reg, Line[{pt - {u, v}, pt + {u, v}}]],
u^2 + v^2 >= (L/2)^2}, {u, v}];
vector = If[instance =!= {}, instance[[1]], {u -> 1, v -> 0}];
Show[plot,
Graphics[{Red, AbsolutePointSize[5], Point[pt],
Arrow[{pt, pt - L/2 Normalize@{u, v}}],
Arrow[{pt, pt + L/2 Normalize@{u, v}}]} /. vector]];
Manipulate[vector,
Show[plot, fig[pt],   PlotRange -> {{0, 10}, {0, 10}}, ]]];
PerformanceGoal ->Manipulate[
"Quality"]fig[pt], {{pt, pt0}, Locator,
TrackingFunction -> {pt = nearest@#; &}}, SaveDefinitions -> True]

deleted 18 characters in body
cvgmt
• 45.6k
• 3
• 30
• 66
Clear["Global*"];
pts = {{0., 0.}, {10., 0.}, {5., 8.}, {1., 6.}} // Rationalize;
reg = Polygon[pts];
L = 8.0 // Rationalize;
conditions =
Exists[{x1, y1, x2,
y2}, {x1, y1} \[Element]∈ reg && {x2, y2} \[Element]∈
reg && {x2 - x1, y2 - y1} . {x2 - x1, y2 - y1} >= L^2,
x == (x1 + x2)/2 && y == (y1 + y2)/2];
results = Resolve[conditions, Reals] // FullSimplify;
plot = RegionPlot[results, {x, 0, 10}, {y, 0, 10}, PlotPoints -> 80,
MaxRecursion -> 4, Prolog -> {EdgeForm[Cyan], FaceForm[], reg}];
domain = DiscretizeGraphics[plot];
nearest = RegionNearest@domain;
pt0 = {x, y} /. FindInstance[results, {x, y}][[1]];
fig[pt_] :=
Module[{instance, vector},
instance =
FindInstance[{RegionWithin[reg, Line[{pt - {u, v}, pt + {u, v}}]],
u^2 + v^2 >= (L/2)^2}, {u, v}];
vector = If[instance =!= {}, instance[[1]], {u -> 1, v -> 0}];
Graphics[{Red, AbsolutePointSize[5], Point[pt],
Arrow[{pt, pt - L/2 Normalize@{u, v}}],
Arrow[{pt, pt + L/2 Normalize@{u, v}}]} /. vector]];
Manipulate[
Show[plot, fig[pt], PlotRange -> {{0, 10}, {0, 10}},
PerformanceGoal -> "Quality"], {{pt, pt0}, Locator,
TrackingFunction -> {pt = nearest@#; &}}, SaveDefinitions -> True]
`
cvgmt
• 45.6k
• 3
• 30
• 66
cvgmt
• 45.6k
• 3
• 30
• 66
cvgmt
• 45.6k
• 3
• 30
• 66
cvgmt
• 45.6k
• 3
• 30
• 66
cvgmt
• 45.6k
• 3
• 30
• 66
cvgmt
• 45.6k
• 3
• 30
• 66
cvgmt
• 45.6k
• 3
• 30
• 66
cvgmt
• 45.6k
• 3
• 30
• 66
cvgmt
• 45.6k
• 3
• 30
• 66
cvgmt
• 45.6k
• 3
• 30
• 66
cvgmt
• 45.6k
• 3
• 30
• 66