Re: How draw 3D Arrows?
- To: mathgroup@smc.vnet.net
- Subject: [mg11263] Re: How draw 3D Arrows?
- From: Paul Abbott <paul@physics.uwa.edu.au>
- Date: Wed, 4 Mar 1998 01:39:21 -0500
- Organization: University of Western Australia
- References: <6dg8gm$2u3@smc.vnet.net>
Terry Harter wrote:
> While I realize that the 'Arrow' package of Mathematica can draw
> *two-dimensional" arrows, the package fails at giving a 3D arrow.
> Anyone have any ideas or suggestions? Say I have 2, distinct 3-dim
> points {a,b,c} and {x,y,z}, how do I then draw a 3-dim arrow from
> {a,b,c} to {x,y,z} with the "head" of the arrow at {x,y,z}? I could
> find nothing on this in MathSource. Many thanks in advance! .....Terry
Appended below is some code written by John Novak from Wolfram Research
which does what you want. This has not yet been included in
StandardPackages.
Cheers,
Paul
____________________________________________________________________
Paul Abbott Phone: +61-8-9380-2734
Department of Physics Fax: +61-8-9380-1014
The University of Western Australia Nedlands WA 6907
mailto:paul@physics.uwa.edu.au AUSTRALIA
http://www.pd.uwa.edu.au/~paul
God IS a weakly left-handed dice player
____________________________________________________________________
(* :Title: Arrow 3D *)
(* :Context: Graphics`Arrow3D` *)
(* :Author: John M. Novak *)
(* :Summary: crude 3D arrow primitive *)
(* :Copyright: Copyright 1996 Wolfram Research, Inc. *)
(* :Package Version: 1.0 *)
(* :Mathematica Version: 3.0 *)
(* :History:
V1.0 -- March 1996 by John M. Novak *)
(* :Keywords:
arrow, Graphics3D
*)
(* :Sources:
Tom Wickham-Jones, "Mathematica Graphics" *)
(* :Discussion:
This is a package to add crude 3D arrows by using 3D graphics
primitives.
The main problem with this approach is that arrows don't have an
optimal
appearance, and distinction between (e.g.) arrows point toward vs. away
from the user is difficult to make. On the other hand, it is readily
implementable, which is far superior to any other approach available at
this time. (The PostScript used in 2D arrows won't layer correctly in
3D, nor would 2D primitives; placing 3D planar primitives with the
correct orientation has problems with perspective transforms as well as
design problems with things like arrows with a small angle w.r.t. the
user.) Because of the essentially different approach from 2D arrows,
the
package is being made independent of the 2D package for the time being.
*)
BeginPackage["Graphics`Arrow3D`"]
Arrow3D::usage =
"Arrow3D[start, end] is a 3D graphics primitive representing an arrow in
space. The start point and the end point are given as {x, y, z}
triplets.
Options controlling the length and width of the arrowhead are
available."
Begin["`Private`"]
(* The following routine is based on OrthogonalVectors from Tom
Wickham-Jones' Mathematica Graphics book. *)
anOrthogonalVector[ norm:{_,_,_}] :=
Block[{pos, a, b, v1},
pos = If[ VectorQ[ norm, NumberQ],
Abs[N[ norm]], norm] ;
pos = Sort[ Transpose[ {pos, Range[ 3]}]] ;
{pos, a,b} = Map[ Last, pos] ;
v1 = ReplacePart[ {0,0,0}, -Part[ norm, a], b] ;
ReplacePart[ v1, Part[ norm, b], a]
]
normalize[vec_] := vec/Sqrt[vec . vec]
(* The following routine 'rotationmatrix' was borrowed from the standard
package Graphics`SurfaceOfRevolution`. *)
rotationmatrix[axis_,theta_] :=
Module[{n1,n2,n3},
{n1,n2,n3} = normalize[axis]//N;
{{n1^2 + (1 - n1^2) Cos[theta],
n1 n2 (1 - Cos[theta]) + n3 Sin[theta],
n1 n3 (1 - Cos[theta]) - n2 Sin[theta]},
{n1 n2 (1 - Cos[theta]) - n3 Sin[theta],
n2^2 + (1 - n2^2) Cos[theta],
n2 n3 (1 - Cos[theta]) + n1 Sin[theta]},
{n1 n3 (1 - Cos[theta]) + n2 Sin[theta],
n2 n3 (1 - Cos[theta]) - n1 Sin[theta],
n3^2 + (1 - n3^2) Cos[theta]}}//N
]
Arrow3D[base:{_,_,_},tip:{_,_,_}, polys_:10, len_:0.8] :=
{Line[{base, tip}],
mycone[tip - base, base, tip, polys, len]}
Arrow3D[base:{_,_,_}, tip:{_, _, _}, ___] :=
Point[base]/;base == tip
mycone[vec_, base_, tip_, polys_, len_] :=
Block[{norm = anOrthogonalVector[vec], theta},
Map[Polygon[Append[#, tip]]&,
Partition[Table[base + len vec +
(1 - len)/2 norm . rotationmatrix[vec, theta],
{theta, 0, 2 Pi, 2 Pi/polys}]//N, 2, 1]
]
]
End[]
EndPackage[]