       Re: How to make curved arrows?

• To: mathgroup at smc.vnet.net
• Subject: [mg28756] Re: How to make curved arrows?
• From: Tom Burton <tburton at cts.com>
• Date: Fri, 11 May 2001 20:00:34 -0400 (EDT)
• References: <9dg5d0\$j3c@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

```Hello,

Paste the notebook expression below into Mathematica and then evaluate the notebook to see and try out my extension of Graphics`Arrow.

Tom

On 11 May 2001 03:46:40 -0400, in comp.soft-sys.math.mathematica you wrote:

>Dear NG,
>
>I wish to draw a figure in Mathematica that involves indicating the angle of
>some triangle. I thought that the only way to do it is to make acurved arrow (I
>hope you know what I mean), please advise me on how I can do this. Thanks in
>
>Sincerely,
>Jose Capco

Notebook[{

Cell[CellGroupData[{
Cell["Extended Graphics`Arrow`Arrow", "Section"],

Cell["\<\
The package Graphics`Arrow` provides the form Arrow[start,finish], \
creating a straight line with an arrow at the end. This section \
extends the form to circular and elliptical arcs, analogous to the \
two-dimension Graphics primitive Circle. The Graphics`Arrow` package \
should be loaded before this section's definitions are executed.\
\>", "Text"],

Cell[BoxData[
\(Needs["\<Graphics`Arrow`\>"]\)], "Input",
InitializationCell->True],

Cell[TextData[{
"The following should be evaluated ",
StyleBox["before",
FontSlant->"Italic"],
" the function Arrow is updated."
}], "Text"],

Cell[CellGroupData[{

Cell[BoxData[
\(\(?Arrow\)\)], "Input",
Evaluatable->False],

Cell[BoxData[
RowBox[{"\<\"Arrow[start, finish, (opts)] is a graphics primitive \
representing an arrow starting at start and ending at finish.\"\>",
" ",
ButtonBox[
StyleBox["More\[Ellipsis]",
"SR"],
ButtonData:>"Graphics`Arrow`",
Active->True,
CellTags->"Info3198545537-9629944"]
}, Open  ]],

Cell["\<\
The purpose of this development is to extend the Graphics`Arrow`Arrow \
function from straight-lines to arcs.\
\>", "Text"],

Cell[BoxData[
\(\(?Circle\)\)], "Input"],

Cell[CellGroupData[{

Cell["Usage", "Subsection"],

Cell["Update the usage message:", "Text"],

Cell[BoxData[
\(\(Graphics`Arrow`Arrow::usage = \*"\"\<Arrow[{\!\(x\_1\), \!\(y\
\_1\)}, {\!\(x\_2\), \!\(y\_2\)} (, opts)] \[LongRightArrow] line \
arrowed at {\!\(x\_2\), \!\(y\_2\)}.\\nArrow[{\!\(x\_0\), \
\!\(y\_0\)}, r, {\!\(\[Theta]\_1\), \!\(\[Theta]\_2\)} (, opts)] \
\[LongRightArrow] circular arc arrowed at \
\!\(\[Theta]\_2\).\\nArrow[{\!\(x\_0\), \!\(y\_0\)}, {\!\(r\_1\), \
\!\(r\_2\)}, {\!\(\[Theta]\_1\), \!\(\[Theta]\_2\)} (, opts)] \
\[LongRightArrow] elliptical arc arrowed at \
\!\(\[Theta]\_2\).\\nResembles the Circle primitive, except that \!\(\
\[Theta]\_2\)<\!\(\[Theta]\_1\) is permitted.\\nArrow accepts only a \
sequence of options, not lists or embedded lists or \
options.\>\"";\)\)], "Input",
InitializationCell->True],

Cell[BoxData[
\(\(?Arrow\)\)], "Input"]
}, Closed]],

Cell[CellGroupData[{

Cell["Development", "Subsection"],

Cell["\<\
The basic idea is to draw an arc and then put a very short arrowed \
line at the second end of it. The following issues must be resolved:
\t1. The size of the arrowhead, if relative, must relate to the \
length of the arc rather than the length of the short segment at the \
end of the arc to which the arrow is attached.
\t2. The position and orientation of the short arrowed segment must \
be correct.\
\>", "Text"],

Cell[CellGroupData[{

Cell["Parametric form of the elliptical arc", "Subsubsection"],

Cell[BoxData[
\(\(SetOptions[Graphics, Axes \[Rule] True,
PlotRange \[Rule] {{\(-1\), 1}, {\(-1\), 1}},
AspectRatio \[Rule] 1];\)\)], "Input"],

Cell[BoxData[
\(\(arc1 =
Show[Graphics[{Circle[{0, 0}, { .3,  .7}, {0, \[Pi]/2}],
Circle[{0, 0}, { .7,  .3}, {\[Pi], 5  \[Pi]/4}],
Line[{{\(-1\), \(-1\)}, {1, 1}}]}]];\)\)], "Input"],

Cell["\<\
The angle in the Circle is that of the following parametric form,\
\>", "Text"],

Cell[BoxData[
\(\(ellipse =
ParametricPlot[{0.7\ Cos[\[Theta]],
0.3\ Sin[\[Theta]]}, {\[Theta], 5  \[Pi]/4, 2  \[Pi]},
PlotStyle \[Rule] {Thickness[0.007],
Dashing[{ .02,  .03}]},
PlotRange \[Rule] {{\(-1\), 1}, {\(-1\), 1}},
AspectRatio \[Rule] 1];\)\)], "Input"],

Cell["as can be seen by overlaying the two plots:", "Text"],

Cell[BoxData[
\(\(Show[arc1, ellipse];\)\)], "Input"]
}, Closed]],

Cell[CellGroupData[{

Cell["1. Size of the arrowhead", "Subsubsection"],

Cell["The length of an arc is", "Text"],

Cell[BoxData[
\(Clear[\[Theta], L]\)], "Input"],

Cell[BoxData[
\[Theta])\))\)\^2 + \((r\_2\ \(sin(\[Theta])\))\)\^2)\) \
\[DifferentialD]\[Theta]\)], "Input"],

Cell[TextData[{
"so the length of a segment from ",
Cell[BoxData[
" to ",
Cell[BoxData[
" is ",
Cell[BoxData[
"."
}], "Text"],

Cell["\<\
What is an appropriate length for the short segment? The longest \
acceptable segment depends upon the resolution of the plot and \
thickness of the line. I don't know these things. So let's just take \
a very small number compared to the maximum radius:\
\>", "Text"],

Cell[BoxData[
\(\[Delta] = 1\/100\ Max[r\_1, r\_2]\)], "Input"]
}, Closed]],

Cell[CellGroupData[{

Cell["2. Position and direction of the arrowhead", "Subsubsection"],

Cell["The position and direction at the second end of an arc are", \
"Text"],

Cell[BoxData[
\(p[\[Theta]_] = {\(r\_1\) Cos[\[Theta]], \(r\_2\)
Sin[\[Theta]]}; p[\[Theta]\_2]\)], "Input"],

Cell[BoxData[
\(\(#\/\@\(# . #\) &\)[\[PartialD]\_\[Theta]
p[\[Theta]]] /. \[Theta] \[Rule] \[Theta]\_2\)], "Input"]
}, Closed]]
}, Closed]],

Cell[CellGroupData[{

Cell["Code", "Subsection"],

"Text"],

Cell[BoxData[
\(Graphics`Arrow`Arrow[{x0_, y0_},
r_?NumericQ, {\[Theta]1_?NumericQ, \[Theta]2_?NumericQ},
opts___?OptionQ] :=
Graphics`Arrow`Arrow[{x0, y0}, {r, r}, {\[Theta]1, \[Theta]2},
opts]\)], "Input",
InitializationCell->True],

Cell[BoxData[
\(Graphics`Arrow`Arrow[{x0_, y0_}, {r1_,
r2_}, {\[Theta]1_?NumericQ, \[Theta]2_?NumericQ},
opts___?OptionQ] := \[IndentingNewLine]Module[{r, x,
y, \[Theta], L, \[Delta], \[CapitalDelta], a, p, s,
rev = Identity, sg = \(+1\), myOpts}, \[IndentingNewLine]x /:
x\_0 = x0; y /: y\_0 = y0; r /: r\_1 = r1;
r /: r\_2 =
r2; \[Theta] /: \[Theta]\_1 = \[Theta]1; \[Theta] /: \
\[Theta]\_2 = \[Theta]2; \[IndentingNewLine]L[\[Theta]_] =
1\/4\ Sin[2\ \[Theta]]\ \((r\_1\%2 - r\_2\%2)\) +
1\/2\ \[Theta]\ \((r\_1\%2 +
r\_2\%2)\); \[CapitalDelta] =
Abs[L[\[Theta]\_2] - L[\[Theta]\_1]]; \[Delta] =
1\/100\ Max[r\_1, r\_2]; a = \[CapitalDelta]/\[Delta];
p /: p\_2 = {x\_0, y\_0} + {Cos[\[Theta]\_2]\ r\_1,
Sin[\[Theta]\_2]\ r\_2};
s /: s\_2 = {\(-Sin[\[Theta]\_2]\)\ r\_1, Cos[\[Theta]\_2]\ r\
\_2}\/\@\(Sin[\[Theta]\_2]\^2\ r\_1\%2 + Cos[\[Theta]\_2]\^2\ r\_2\%2\
\); \[IndentingNewLine]If[\[Theta]\_1 > \[Theta]\_2, \
\[IndentingNewLine]sg = \(-1\);
rev = Reverse\[IndentingNewLine]]; \
Options[Arrow])\) ===
Relative, \[IndentingNewLine]myOpts =
a\ h)\), \[IndentingNewLine]myOpts =
Flatten[{opts}]\[IndentingNewLine]]; \
\[IndentingNewLine]{Circle[{x\_0, y\_0}, {r\_1, r\_2},
rev[{\[Theta]\_1, \[Theta]\_2}]],
Arrow[p\_2 - \[Delta]\ sg\ s\_2, p\_2,
Sequence @@ myOpts]}\[IndentingNewLine]]\)], "Input",
InitializationCell->True]
}, Closed]],

Cell[CellGroupData[{

Cell["Local tests", "Subsection"],

Cell[BoxData[
\(\(SetOptions[Graphics, Axes \[Rule] True,
PlotRange \[Rule] Automatic,
AspectRatio \[Rule] 1];\)\)], "Input"],

Cell[BoxData[
\(\(Show[
Graphics[{Arrow[{0, 0}, {1, 1}], Arrow[{0, 0}, 1, {0, 1}],
Arrow[{0, 0}, 0.7, {1, 0}],
Arrow[{0, 0}, 1, {\[Pi], \[Pi] + 1}],
Arrow[{0, 0}, 0.7, {\[Pi] + 1, \[Pi]}],
Arrow[{0, 0},  .85, {130  \[Degree], 110  \[Degree]}],
Arrow[{0, 0},  .85, {130  \[Degree],
150  \[Degree]}]}]];\)\)], "Input"],

Cell[BoxData[
\(\(Show[
Graphics[{Thickness[0.01], Arrow[{0, 0}, {1, 1}],
Arrow[{0, 0}, 1, {0, 1}]}]];\)\)], "Input"],

Cell[BoxData[

Cell[BoxData[
\(\(Show[
Graphics[{Thickness[0.01],
Arrow[{0, 0}, {1, 1}, HeadScaling \[Rule] Relative,
Arrow[{0, 0}, 1, {0, 1}, HeadScaling \[Rule] Relative,
}, Closed]]
}, Open  ]]
},
FrontEndVersion->"4.1 for Microsoft Windows",
ScreenRectangle->{{0, 1280}, {0, 979}},
WindowSize->{724, 740},
WindowMargins->{{36, Automatic}, {Automatic, 46}}
]

Tom Burton

```

• Prev by Date: Re: Peculiar behavior of DiscreteDelta
• Next by Date: Re: Replacing Parts of a List
• Previous by thread: Re: How to make curved arrows?
• Next by thread: Re: How to make curved arrows?