       Re: Are there Arrow-like objects in 3D

• To: mathgroup at smc.vnet.net
• Subject: [mg98456] Re: Are there Arrow-like objects in 3D
• From: dr DanW <dmaxwarren at gmail.com>
• Date: Fri, 10 Apr 2009 04:53:31 -0400 (EDT)
• References: <grhp9g\$mjf\$1@smc.vnet.net>

```Below is code I wrote for a 3D arrowhead in version 6 (don't know how
many times I have written a handy utility just to have it obsoleted
with the next revision of Mathematica...)  Some of the techniques are
borrowed from a package by John Novak of Wolfram Research, ca. 1997,
but the package has been essentially rewritten to bring it up to
Mathematica 6 standards.

If you are wondering, there is a lot of extra code here because the
line part would sometimes show through the cone part of the arrow.

Code follows
----------------

BeginPackage["Arrow3D`"]

ArbitraryOrthonormal::usage = "ArbitraryOrthonormal [ vec ] returns \
an arbitrary unit vector normal to the vector vec.";

Cone::usage = "Cone[ { base, tip }, width, polys ] return the graphics
\
primitives to draw a cone on the axis from base to tip.  Optional \
parameter width gives the diameter of the base relative to the height
\
of the cone, and polys gives the number of polygons used to draw \
the surface.";

Arrow3D::usage = "Arrow3D [ { start, end }, opts ] returns the
graphics \
primitives to draw a 3D arrow from points start to end. \n \
Arrow3D[ Line [...] , opts ] also works. \n \
Arrow3D[ opts ] returns a pure function that can be applied to a Line
[...].";

Clipping::usage = "Clipping is an option for Arrow3D.  If true, the \
arrow line is clipped within the arrowhead, preventing the glitch \
that can allow the line to show through.";

controls \
the length of the head, given in units of the plot or relative to the
\
line length as given by the option HeadLengthRelative.  When a
negative, \
value is given, the head is reversed.";

Arrow3D.  When True, the option Headlength defines the length of the \
head as a fraction of the length of the whole arrow.  When False, \
HeadLength defines the length of the head in the units of the rest \
of the graphic.";

TipLocation::usage = "TipLocation is an option for Arrow3D which sets
\
the fractional distance along the length of the arrow line at which
the \
tip of the arrowhead is drawn.";

\
the width of the base of the arrowhead cone relative to its length.";

Polygons::usage = "Polygons is an option for Arrow3D, defining the
number \
of polygons used to form the sides of the arrowhead cone.";

graphics directives to be applied to the arrowhead.  Enclose \
multiple directives in Directive[...].  Warning: as with all graphics
\
directives, settings will effect graphics downstream.";

Begin["`Private`"]
(* Implementation of the package *)

ArbitraryOrthonormal[v:{_,_,_}] :=
Module[ {a,b,c},
{a,b,c} = Ordering[If[ VectorQ[v,NumericQ],
Abs[v],
v
]];
Normalize[
ReplacePart[{0,0,0}, {c->-v[[ b ]], b->v[[ c ]]} ]
]
]

Cone[{base_, tip_}, width_:1/GoldenRatio, polys_:10] :=
Module[ {axis, ortho, rt, init, verts, gcd},
axis = tip-base;
ortho = ArbitraryOrthonormal[axis];
rt = RotationTransform[ N[(2\[Pi])/polys ], axis, tip ];
init = N[ base+width Norm[axis] ortho/2 ];
verts = Join[ {tip}, NestList[rt, init, polys-1] ];
gcd = Flatten[ {Polygon[Flatten[{1, #}] ]&
/@ Partition[ Mod[ Range[0, polys], polys ]+2, 2, 1],
Polygon[ Range[polys] + 1] } ];
GraphicsComplex[verts, gcd]
]

arrowPrimitive[start_,end_,hl_,width_,tl_,polys_,clip_,hstyle_] :=
axis = end - start;
tip = start + tl*axis;
base = tip - hl*axis;
line = If[ clip===True,
Switch[Ordering[{0, 1, tl-hl, tl}],
{1,3,4,2},{Line[{start,base}],Line[{end,tip}]},
{3,1,2,4},{},
{1,2,3,4}|{3,4,1,2},{Line[{start,end}]},
{1,3,2,4},{Line[{start,base}]},
{3,1,4,2},{Line[{tip,end}]}
],
{Line[{start,end}]}
];
]

Options[Arrow3D] = {
Clipping->True,
TipLocation->1,
Polygons->10,
};

Arrow3D[ { start:{ _, _, _ }, end:{ _, _, _ } }, ___ ] :=
Point[start]/;start===end

Arrow3D[ Line[ { start_, end_ } ], opts:OptionsPattern[] ] :=
Arrow3D[ { start, end }, opts ]

Arrow3D[opts:OptionsPattern[] ] :=
Arrow3D[ #, opts ]&

Arrow3D[
{start:{_?NumericQ,_?NumericQ,_?NumericQ},
end:{_?NumericQ,_?NumericQ,_?NumericQ}},
OptionsPattern[]] :=
Module

=
OptionValue
];
{s,e} = {start,end},
(* Else *)
{s,e} = {end,start};
tiplocation = 1-tiplocation
];
arrowPrimitive
]

End[]

Protect[ Evaluate[ Context[] <> "*" ] ]

EndPackage[]

----------
end code

Example of use:

HeadStyle -> Directive[Yellow, EdgeForm[]], Clipping -> True]

Graphics3D[{
Arrow3D[{{4, 5, 6}, {2, -6, 1}}],
Arrow3D[{{-7, 3, 4}, {1, 3, 4}}, Polygons -> 50]
}]

Enjoy.
Daniel W

```

• Prev by Date: Re: Re: UNDO and Mathematica - how useless is it?
• Next by Date: Re: dynamic popupmenu help needed
• Previous by thread: Re: Are there Arrow-like objects in 3D
• Next by thread: PlotLegends bug?