I already found this Example but i want to add a description and the individual vectors as in the picture.
My approach so far:
TangentSurface[a_, b_] :=
Module[{nv, pt, tangentsurface, func, grad, dx, dy, tanpt, x, y, z,
tanexpr, gr1, gr2, normalv, r = 0.7},
func[x_, y_] := (y Cos[x] + x Sin[y])/5;
dx[x_, y_] := D[func[x, y], x];
dy[x_, y_] := D[func[x, y], y];
grad[x_, y_] := {dx[x, y], dy[x, y], -1};
nv = {dx[x, y], dy[x, y], -1};
nv = nv/Norm[nv] /. {x -> a, y -> b};
pt = {a, b, func[a, b]};
tanpt = {x, y, z};
gr1 = Plot3D[func[x, y], {x, -8, 8}, {y, -8, 8}, PlotPoints -> 100,
BaseStyle -> {FontSize -> 6}, PlotRange -> All, Boxed -> False,
PlotStyle -> None, Mesh -> 35, MeshStyle -> Red,
BoundaryStyle -> Red, Lighting -> "Neutral",
Axes -> {True, True, False}];
tanexpr = (tanpt - (pt + .05 nv)).nv;
tangentsurface = z /. First@Solve[tanexpr == 0, z];
gr2 = Graphics3D[{RGBColor[96/255, 96/255, 96/255],
ControlActive[Opacity[1], Opacity[.9]],
Polygon[{{a + r, b + r,
tangentsurface /. {x -> a + r, y -> b + r}}, {a + r, b - r,
tangentsurface /. {x -> a + r, y -> b - r}}, {a - r, b - r,
tangentsurface /. {x -> a - r, y -> b - r}}, {a - r, b + r,
tangentsurface /. {x -> a - r, y -> b + r}}}]}];
normalv =
Graphics3D[{Specularity[White, 50], RGBColor[.2, .4, 0],
Cylinder[{pt, pt - nv}, .07], Black, Specularity[White, 50],
Sphere[{a, b, func[a, b]}, .2]}];
contourPotentialPlot =
ContourPlot[func[x, y], {x, -8, 8}, {y, -8, 8}, Contours -> 15,
Axes -> False, Frame -> False, ColorFunction -> None];
level = -4;
pts = Append[#, level] & /@ contourPotentialPlot[[1, 1]];
cts = Cases[contourPotentialPlot, Line[l_], Infinity];
cts3D = Graphics3D[GraphicsComplex[pts, {Opacity[.5], cts}]];
Show[gr1, gr2, cts3D, PlotRange -> All, BoxRatios -> {1, 1, .5},
FaceGrids -> {Bottom, Back, Left}, ViewPoint -> {2, -2, 1},
ImageSize -> {800, 600}, Boxed -> False]]
Manipulate[
TangentSurface[a, b],
{{a, 1, "x"}, -8, 8},
{{b, 1, "y"}, -8, 8},
SaveDefinitions -> True]
gr2
contains all neccessary information. $\endgroup$