Flecha 3D

(* Integrantes de MaTECmática http://matecmatica.blogspot.com/ *)

(* No me gusto la flecha 3D de mi correo anterior *)

(* Así que hice mi propio comando para hacer flechas en 3D. Quedan más bonitas. Más abajo está el código y ejemplos *)

(* flecha3d tiene la misma sintaxis que el comando Arrow,
donde el significado de los dos puntos es diferente si están o No
están agrupado entre llaves: flecha3d[{{x1,y1,z1},{x2,y2,z2}}] es una
flecha desde un punto {x1,y1,z1} al punto {x2,y2,z2}, pero si los
puntos No están agrupados con llaves, es decir de esta otra forma:
flecha3d[{x1,y1,z1},{x2,y2,z2}] entonces es una flecha que va del
punto {x1,y1,z1} al punto {x1+x2,y1+y2,z1+z2}, como en suma de
vectores
*)
(* Esta es la creación del nuevo comando flecha3d *)
flecha3d[{x1_, y1_, z1_}, {dx_, dy_, dz_}] :=
flecha3d[{{x1, y1, z1}, {x1 + dx, y1 + dy, z1 + dz}}];
flecha3d[{x1_, y1_, z1_}, d_] :=
flecha3d[{{x1, y1, z1}, {x1 + d, y1 + d, z1 + d}}];
flecha3d[{{x1_, y1_, z1_}, {x2_, y2_, z2_}}] :=
Module[{vector, magnitud, normal, vectornormal, cruz,
vectorbinormal},
vector = {x2 - x1, y2 - y1, z2 - z1};
magnitud = Norm[vector];
normal = {0, z1 - z2, y2 - y1};
vectornormal = magnitud*normal/Norm[normal];
cruz = Cross[vector, vectornormal];
vectorbinormal = magnitud*cruz/Norm[cruz];
{Cylinder[{{x1, y1, z1}, {x1, y1, z1} + 0.8 vector},
0.01 magnitud],
Polygon[{{x1, y1, z1} + 0.8 vector +
0.1 vectornormal, {x1, y1, z1} + 0.8 vector -
0.1 vectornormal, {x2, y2, z2}}],
Polygon[{{x1, y1, z1} + 0.8 vector +
0.1 vectorbinormal, {x1, y1, z1} + 0.8 vector -
0.1 vectorbinormal, {x2, y2, z2}}]}
];

(* Después de haber evaluado (Shift-Enter) los comandos anteriores,
flecha3d ya puede usarse. Aquí está un ejemplo sencillo. Observa el
uso de PlotRange->All para asegurar que se dibuja toda la flecha
completa *)
Graphics3D[{flecha3d[{{1, 2, 3}, {4, 5, 6}}]}, PlotRange -> All]

(* otro ejemplo, combinando la flecha con una esfera *)
Graphics3D[{Sphere[{1, 1, 1}, 0.2],
flecha3d[{{1.5, 1, 1}, {2, 2, 2}}]}, PlotRange -> All]

(* otro ejemplo *)
Graphics3D[{Sphere[{1, 1, 1}, 0.2],
flecha3d[{{1.5, 1, 1}, {2, 2, 2}}],
flecha3d[{{1.5, 0, 1}, {-2, -2, 2}}]}, PlotRange -> All]

(* Saludos *)