Definice

rxitoxyz={(Subscript[x, 1])->x,(Subscript[x, 2])->y,(Subscript[x, 3])->z};
rrtoxi={r->(Sqrt[((Subscript[x, 1])^2)+((Subscript[x, 2])^2)+((Subscript[x, 3])^2)])};

potential[list_]:=((Product[(Subscript[x, list[[i]]]),{i,Length[list]}])/(r^(2Length[list]+1)))/.rrtoxi
Efield[ϕ_]:=FullSimplify@Table[-D[ϕ,(Subscript[x, i])],{i,3}]
addOffset[Ef_,α_,off_]:=(((r^α)/.rrtoxi)/(((((Subscript[x, 1])^2)+((Subscript[x, 2])^2)+((Subscript[x, 3])^2)+off))^(α/2)))Ef
to2D[Ef_,α_]:=((r^α)Ef[[1;;2]]/.rrtoxi)/.{(Subscript[x, 3])->0}

inset[text_,pos_]:=If[StringLength[text]==0,{},Inset[Framed[Style[text,15],FrameStyle->White,Background->White],{pos,Top},{Left,Top}]];

vecGraph[Ef2D_,vecNumber_,vecScale_,range_,exclRegion_,text_,imgsize_]:=VectorPlot[If[((Subscript[x, 1])^2)+((Subscript[x, 2])^2)<exclRegion-1,0,Ef2D],{(Subscript[x, 1]),-range,range},{(Subscript[x, 2]),-range,range},RegionFunction->Function[{x,y,vx,vy,n},(x^2)+(y^2)>exclRegion],PlotRange->{{-range,range},{-range,range}},VectorPoints->RandomReal[{-range,range},{vecNumber,2}],VectorScale->vecScale,FrameTicks->None,Epilog->inset[text,-range+0.05],ImageSize->If[imgsize>0,imgsize,Automatic]];
streamGraph[Ef2D_,range_,exclRegion_,text_,imgsize_]:=StreamPlot[Ef2D,{(Subscript[x, 1]),-range-1,range+1},{(Subscript[x, 2]),-range-1,range+1},PlotRange->{{-range,range},{-range,range}},RegionFunction->Function[{x,y,vx,vy,n},(x^2)+(y^2)>exclRegion],FrameTicks->None,Epilog->inset[text,-range+0.05],ImageSize->If[imgsize>0,imgsize,Automatic]];

views={{1.3,-2.4,2},{0,0,∞},{0,-∞,0},{-∞,0,0}};(* {1 = Default, 2 = Orthographic Top, 3 = Orthographic Front, 4 = Orthographic Left} *)
contourGraph[ϕ_,iso_,range_,view_,text_,imgsize_]:=Quiet@ContourPlot3D[{ϕ==iso,ϕ==-iso},{(Subscript[x, 1]),-range,range},{(Subscript[x, 2]),-range,range},{(Subscript[x, 3]),-range,range},Ticks->None,Mesh->None(*,Boxed->False*),ViewPoint->views[[view]],Epilog->inset[text,-range+0.05],ImageSize->If[imgsize>0,imgsize,Automatic]];

finalGrid[list_,label_,numVectors1_,weightVectors1_,numVectors2_,weightVectors2_,offset_,isoLevel_]:=Module[
{ϕ=potential[list],Ef,El,Ep,range=10,exclusion=5},

Ef=Efield[ϕ];
El=to2D[addOffset[Ef,2Length[list]+3,offset],0];
Ep=to2D[addOffset[Ef,0,0],Length[list]+2];

GraphicsGrid[{{
vecGraph[El,numVectors1,weightVectors1,range,exclusion,"Elektrické pole (OverVector[E])",0],
vecGraph[Ep,numVectors2,weightVectors2,range,exclusion,"\"Směr\" elektrického pole \"(OverVector[n])\" = \!\(\*SuperscriptBox[\(r\), \(\(α\)\(\\ \)\)]\)(OverVector[E]) (α = "<>ToString[Length[list]+2]<>")",0],
streamGraph[El,range,exclusion,"Siločáry elektrického pole (OverVector[E])",0]
},{
contourGraph[ϕ,isoLevel,range,1,"Izoplocha potenciálu (perspektiva)",0],
contourGraph[ϕ,isoLevel,range,2,"Izoplocha potenciálu (zvrchu)",0],
contourGraph[ϕ,isoLevel,range,3,"Izoplocha potenciálu (zpředu)",0]}},
ImageSize->1200 ,PlotLabel->Style[label,20]]
];

superExport[list_,label_,numVectors1_,weightVectors1_,numVectors2_,weightVectors2_,offset_,isoLevel_]:=Module[
{ϕ=potential[list],Ef,El,Ep,range=10,exclusion=5,str,g,imgsize},

Ef=Efield[ϕ];
El=to2D[addOffset[Ef,2Length[list]+3,offset],0];
Ep=to2D[addOffset[Ef,0,0],Length[list]+2];

str=StringReplace[ToString[list],{" "->"","{"->"","}"->"",","->""}];
imgsize=300;

g=vecGraph[El,numVectors1,weightVectors1,range,exclusion,"",imgsize];
Export["multipol_"<>str<>"_1.png",g];
g=vecGraph[Ep,numVectors2,weightVectors2,range,exclusion,"",imgsize];
Export["multipol_"<>str<>"_2.png",g];
g=streamGraph[El,range,exclusion,"",imgsize];
Export["multipol_"<>str<>"_3.png",g];
g=contourGraph[ϕ,isoLevel,range,1,"",imgsize];
Export["multipol_"<>str<>"_4.png",g];
g=Framed[contourGraph[ϕ,isoLevel,range,2,"",imgsize]];
Export["multipol_"<>str<>"_5.png",g];
g=Framed[contourGraph[ϕ,isoLevel,range,3,"",imgsize]];
Export["multipol_"<>str<>"_6.png",g];

];

finalList={
{{},"Monopólový moment, (ϕ/k) = (1/r), ((OverVector[E])/k) = ((OverVector[r])/(r^3))",5000,0.04,3000,0.02,10,0.15},
{{1},"Dipólový moment, (ϕ/k) = \!\(\*FractionBox[\(\*OverscriptBox[\(p\), \(⇀\)]\\ \*OverscriptBox[\(r\), \(⇀\)]\), SuperscriptBox[\(r\), \(3\)]]\), ((OverVector[E])/k) = \!\(\*FractionBox[\(3 \((\*OverscriptBox[\(p\), \(⇀\)] . \*OverscriptBox[\(r\), \(⇀\)])\) \*OverscriptBox[\(r\), \(⇀\)] - \(\*SuperscriptBox[\(r\), \(2\)] \*OverscriptBox[\(p\), \(⇀\)]\(\\ \)\)\), SuperscriptBox[\(r\), \(5\)]]\), (OverVector[p]) = (p, 0, 0)",5000,0.04,3000,0.025,15,0.015},
{{1,1},"Kvadrupólový moment (hlavní moment), (ϕ/k) = \!\(\*FractionBox[\(\*SubscriptBox[\(Q\), \(ij\)]\\ \*SubscriptBox[\(x\), \(i\)] \*SubscriptBox[\(x\), \(j\)]\), SuperscriptBox[\(r\), \(5\)]]\), ((Subscript[E, i])/k) =((5 (Subscript[Q, jk]) (Subscript[x, j]) (Subscript[x, k]) (Subscript[x, i]) - 2 (r^2) (Subscript[Q, ij]) (Subscript[x, j]))/(r^7)), (Subscript[Q, 11]) ≠ 0, jinak (Subscript[Q, ij]) = 0",5000,0.04,3000,0.025,15,0.0018},
{{1,2},"Kvadrupólový moment (deviační moment), (ϕ/k) = \!\(\*FractionBox[\(\*SubscriptBox[\(Q\), \(ij\)]\\ \*SubscriptBox[\(x\), \(i\)] \*SubscriptBox[\(x\), \(j\)]\), SuperscriptBox[\(r\), \(5\)]]\), ((Subscript[E, i])/k) =((5 (Subscript[Q, jk]) (Subscript[x, j]) (Subscript[x, k]) (Subscript[x, i]) - 2 (r^2) (Subscript[Q, ij]) (Subscript[x, j]))/(r^7)), (Subscript[Q, 12]) ≠ 0, jinak (Subscript[Q, ij]) = 0",5000,0.035,2000,0.027,15,0.0006},
{{1,1,1},"Oktupólový moment (hlavní moment xxx), (ϕ/k) = \!\(\*FractionBox[\(\*SubscriptBox[\(O\), \(ijk\)]\\ \*SubscriptBox[\(x\), \(i\)] \*SubscriptBox[\(x\), \(j\)] \*SubscriptBox[\(x\), \(k\)]\), SuperscriptBox[\(r\), \(7\)]]\), ((Subscript[E, i])/k) = ((7 (Subscript[O, jkl]) (Subscript[x, j]) (Subscript[x, k]) (Subscript[x, l]) (Subscript[x, i]) - 3 (r^2) (Subscript[O, ijk]) (Subscript[x, j]) (Subscript[x, k]))/(r^9)), (Subscript[O, 111]) ≠ 0, jinak (Subscript[O, ijk]) = 0",5000,0.035,3000,0.027,15,0.0002},
{{1,1,2},"Oktupólový moment (deviační moment xxy) , (ϕ/k) = \!\(\*FractionBox[\(\*SubscriptBox[\(O\), \(ijk\)]\\ \*SubscriptBox[\(x\), \(i\)] \*SubscriptBox[\(x\), \(j\)] \*SubscriptBox[\(x\), \(k\)]\), SuperscriptBox[\(r\), \(7\)]]\), ((Subscript[E, i])/k) = ((7 (Subscript[O, jkl]) (Subscript[x, j]) (Subscript[x, k]) (Subscript[x, l]) (Subscript[x, i]) - 3 (r^2) (Subscript[O, ijk]) (Subscript[x, j]) (Subscript[x, k]))/(r^9)), (Subscript[O, 112]) ≠ 0, jinak (Subscript[O, ijk]) = 0",5000,0.035,3000,0.027,15,0.00007},
{{1,2,3},"Oktupólový moment (deviační moment xyz) , (ϕ/k) = \!\(\*FractionBox[\(\*SubscriptBox[\(O\), \(ijk\)]\\ \*SubscriptBox[\(x\), \(i\)] \*SubscriptBox[\(x\), \(j\)] \*SubscriptBox[\(x\), \(k\)]\), SuperscriptBox[\(r\), \(7\)]]\), ((Subscript[E, i])/k) = ((7 (Subscript[O, jkl]) (Subscript[x, j]) (Subscript[x, k]) (Subscript[x, l]) (Subscript[x, i]) - 3 (r^2) (Subscript[O, ijk]) (Subscript[x, j]) (Subscript[x, k]))/(r^9)), (Subscript[O, 123]) ≠ 0, jinak (Subscript[O, ijk]) = 0",2,0.01,2,0.01,15,0.00002}
};

Generování potenciálu a el.pole

list={1,1}; (* {} - monopol, {i} - dipol, {i,j} - kvadrupol, {i,j,k} - oktupol, ... atd.; i,j,k ∈ [1,2,3] *)
p=potential[list]
Ef=Efield[p]
to2D[Ef,0]

Vykreslení gridu obrázků pro tisk

i=1; (* 1 - monopol, 2 - dipol, 3 - hlavi kvadrupol, 4 - vedlejsi kvadrupol, 5 - hlavni oktupol, 6 - vedlejsi oktupol 112, 7 - vedlejsi oktupol 123 *)
finalGrid@@finalList[[i]]

Vykreslení gridu obrázků pro tisk

i=1; (* 1 - monopol, 2 - dipol, 3 - hlavi kvadrupol, 4 - vedlejsi kvadrupol, 5 - hlavni oktupol, 6 - vedlejsi oktupol 112, 7 - vedlejsi oktupol 123 *)
superExport@@finalList[[i]]