Bilder für das Buch

Splines-und-NURBS.nb

Buch:Höhere Mathematik sehen und verstehen, Haftendorn, Riebesehl, Dammer, 
Springer Spektrum, Feb. 2021
Datei Splines-und-NURBS.nb zu Abschnitt 5.4.3.1 Seite 379, Abb. 5.23

Bézier-Splines zusammengesetzt

Bézier-Basisfunktionen definieren, auf Einheitsintervall einschränken und darüber hinaus durch Null fortsetzen.

b0[t_]:=Piecewise[{{(((1-t))^3),0<t≤1},{0,True}}]

b1[t_]:=Piecewise[{{3t (((1-t))^2),0<t≤1},{0,True}}]

b2[t_]:=Piecewise[{{3(t^2)(1-t),0<t≤1},{0,True}}]

b3[t_]:=Piecewise[{{(t^3),0<t≤1},{0,True}}]

4 + 4 Punkte definieren, aber der 4. ist gleich dem 5.

PSb={{0,1},{1,3},{2,3},{3,1},{3,1},{4,0},{5,0},{6,1}};

Der zusammengesetzte Bézierspline. Für die zweite Hälfte werden die Basisfunktionen einfach nach rechts um 1 verschoben.

BSb[t_]:={b0[t],b1[t],b2[t],b3[t],b0[t-1],b1[t-1],b2[t-1],b3[t-1]}.PSb//Simplify

BSb[t]

Die Interpolierende Kurve trifft zwar die drei gewünschten Punkte (die Kontrollpunkte, die keine Steuerungspunkte sind), ist aber nicht automatisch an der Stelle t=1 stetig. Dies erfordert eine sorgfältige Wahl der Steuerungspunkte.

Show[ParametricPlot[BSb[t]//Evaluate,{t,0,2}],Graphics[{PointSize[0.02],Point[PSb],Line[PSb]}],PlotRange->All]

B-Spline Basisfunktionen

B[i_,0,x_]:=Piecewise[{{1,i≤x<i+1}}]

B[i_,1,x_]:=((x-i)/1)B[i,0,x]+((i+2-x)/1)B[i+1,0,x]//Simplify

B[i_,2,x_]:=((x-i)/2)B[i,1,x]+((i+3-x)/2)B[i+1,1,x]//Simplify

B[i_,3,x_]:=((x-i)/3)B[i,2,x]+((i+4-x)/3)B[i+1,2,x]//Simplify

Im Einzelnen

B[0,0,x]
B[0,1,x]
B[1,1,x]
B[2,1,x]
B[3,1,x]
B[0,2,x]
B[1,2,x]
B[2,2,x]
B[3,2,x]
B[0,3,x]
B[1,3,x]
B[2,3,x]
B[3,3,x]

Plot[{B[0,0,x],
B[0,1,x],
B[1,1,x],
B[2,1,x],
B[3,1,x],
B[0,2,x],
B[1,2,x],
B[2,2,x],
B[3,2,x]},{x,0,7}]

dritten Grades

B[0,3,x]
B[1,3,x]
B[2,3,x]
B[3,3,x]

Plot[{B[0,3,x],
B[1,3,x],
B[2,3,x],
B[3,3,x]},{x,0,7}]

Plot[{B[0,3,x],B[1,3,x],B[2,3,x],B[3,3,x]},{x, 0,7}]

Verschieben realisieren

B[0,3,x]
B[0,3,x-1]
B[0,3,x-2]
B[0,3,x-3]

Plot[{B[0,3,x],
B[0,3,x-1],
B[0,3,x-2],
B[0,3,x-3]},{x,0,7}]

Dieters Bilder

Syntax verstehe ich nicht

Plot[Piecewise[{#}]&/@B[0,1,x][[1]]//Evaluate,{x,0,4},PlotStyle->Thickness[0.015],PlotRange->All]

Plot[Piecewise[{#}]&/@B[0,2,x][[1]]//Evaluate,{x,0,4},PlotStyle->Thickness[0.015],PlotRange->All]

Plot[Piecewise[{#}]&/@B[0,3,x][[1]]//Evaluate,{x,0,4},PlotStyle->Thickness[0.015],PlotRange->All]

Plot[Table[B[i,3,x],{i,0,4}]//Evaluate,{x,0,9},PlotStyle->Thickness[0.015],PlotRange->All,PlotPoints->6]

B-Spline ungeschicktes Beispiel

Definition der Basisfunktionen

Definition der 7 Punkte: der mittlere muss nicht wiederholt werden.

Pu={{0,1},{1,3},{2,3},{3,1},{4,0},{5,0},{6,1}};

Die Basisfunktionen sind überall zweimal stetig differenzierbar.

Der zusammengesetzte B-Spline

BSu[t_]:=(∑_(i=0)^6)P[[i+1]]B[i,3,t]//Simplify

Die interpolierende Kurve trifft keinen der Kontrollpunkte mehr. Dafür ist sie automatisch 2-mal stetig differenzierbar.
An ganzzahligen Werten von t ergeben sich Punkte (rot), die gewichtetes Mittel von nur drei Kontrollpunkten sind (jeweils die naheliegendsten). Alle anderen sind gewichtete Mittel von vier Kontrollpunkten (ebenfalls die naheliegendsten).
Sinnvoll ist nur der Bereich [3,7] für t, weil nur hier immer 4 Basisfunktionen von Null verschieden sind.

Show[ParametricPlot[BSu[t]//Evaluate,{t,3,7}],Graphics[{PointSize[0.02],Point[P],Line[P],Red,Point[Table[BSu[n],{n,3,7}]]}],PlotRange->All]

NURBS

Viertelkreis mit Béziersplines,

Final-Version mit Bestimmungen für den Viertelkreis

echter Kreis -Berechnung

bei Kenntnis der wahren Parameterdarstellung

Pk={{0,1},{e,1},{1,f},{1,0}};

wk={a,b,c,d};

bb=Thread[Times[wk,{b0[t],b1[t],b2[t],b3[t]}]]

Plus@@bb//Simplify

BSk[t_]:=(bb/(Plus@@bb)).Pk//Simplify

BSk[t]

CoefficientList[-a (((-1+t))^3)+t (3 b (((-1+t))^2)+t (3 c-3 c t+d t)),t](*Nenner*)

CoefficientList[t (3 b e (((-1+t))^2)+t (-3 c (-1+t)+d t)),t](*erster Zähler*)

Kenntnis der Parameterdarstellung (Nenner: 1+(t^2), erster Zähler: 2t, zweiter Zähler: -1+(t^2))

lo=Solve[{{a,-3 a+3 b,3 a-6 b+3 c,-a+3 b-3 c+d}=={1,0,1,0},{0,3 b e,3 c-6 b e,-3 c+d+3 b e}=={0,2,0,0}(*,
(-1+t) (a (((-1+t))^2)+3 t (b-b t+c f t))=={-1,0,1,0 }*)},{a,b,c,d,e,f}]

flo=(-1+t) (a (((-1+t))^2)+3 t (b-b t+c f t))/.lo//Expand (*Zweiter Zähler*)

{-1+3 (t^2)-4 f (t^2)-2 (t^3)+4 f (t^3)}/.f->(1/2) (* damit (t^3) verschwindet*)

{-1+(t^2)} (* wie gewünscht *)

Pk={{0,1},{e,1},{1,f},{1,0}}/.{f->(1/2),e->(2/3)}

bb=(bb/.lo)[[1,1]]

BSk[t_]:=((bb/(Plus@@bb)).Pk)//Simplify

BSk[t]

Die interpolierende Kurve ist jetzt eine mit rationalen Parameterfunktionen. Damit sind prinzipiell auch Kreise, Kegelschnitte usw. erreichbar, die alle eine Parametrisierung mit rationalen Funktionen haben. (Die auf S. 7 ist wirklich der Kreis).

Show[ParametricPlot[BSk[t]//Evaluate,{t,0,1}],     Graphics[{PointSize[0.02],Thickness[0.04],Point[Pk],Line[Pk],Red,Circle[{0,0},1,{0,Pi/2}]}],PlotRange->All]

Viertelkreis und Verwandte

Pk={{0,1},{(2/3),1},{1,(1/2)},{1,0}};  (* mit dem neuen Pk*)

wkD={1,1,(4/3),5000}; wkD2={1,1,(4/3),(1/50)};wkD3={1,1,(4/3),10}; wkD4={1,1,(4/3),(1/2)};

bbD=Thread[Times[wkD,{b0[t],b1[t],b2[t],b3[t]}]];
bbD2=Thread[Times[wkD2,{b0[t],b1[t],b2[t],b3[t]}]];
bbD3=Thread[Times[wkD3,{b0[t],b1[t],b2[t],b3[t]}]];
bbD4=Thread[Times[wkD4,{b0[t],b1[t],b2[t],b3[t]}]]

Plus@@bbD//Simplify

Plus@@bbD2//Simplify
Plus@@bbD3//Simplify
Plus@@bbD4//Simplify

BSkD[t_]:=(bbD/(Plus@@bbD)).Pk//Simplify
BSkD2[t_]:=(bbD2/(Plus@@bbD2)).Pk//Simplify
BSkD3[t_]:=(bbD3/(Plus@@bbD3)).Pk//Simplify
BSkD4[t_]:=(bbD4/(Plus@@bbD4)).Pk//Simplify

BSkD[t]

{({{\[Piecewise], ({{((t (2+3 (t^2)))/(1+(t^2)+3 (t^3))), 0<t≤1}, {Indeterminate, True}})}}),({{\[Piecewise], ({{((1-(t^2))/(1+(t^2)+3 (t^3))), 0<t≤1}, {Indeterminate, True}})}})}

BSkD2[t]
BSkD3[t]
BSkD4[t]

Die interpolierende Kurve ist jetzt eine mit rationalen Parameterfunktionen. Damit sind prinzipiell auch Kreise, Kegelschnitte usw. erreichbar, die alle eine Parametrisierung mit rationalen Funktionen haben.

Show[
ParametricPlot[BSkD4[t]//Evaluate,{t,0,1},PlotStyle->{Thickness[0.008],Gray}],(*zu 1/8*)
ParametricPlot[BSkD2[t]//Evaluate,{t,0,1},PlotStyle->{Thickness[0.01],Orange}],(*zu 1/2*)
ParametricPlot[BSk[t]//Evaluate,{t,0,1}, PlotStyle->{Thickness[0.008],Red}(*Dieter zu 2*)],
ParametricPlot[BSkD[t]//Evaluate,{t,0,1},PlotStyle->{Thickness[0.008],Magenta}],(*zu 5*)
ParametricPlot[BSkD3[t]//Evaluate,{t,0,1},PlotStyle->{Thickness[0.008], Blue}],(*zu 10*)Graphics[{Black, Thickness[0.007],Line[Pk],Green,PointSize[0.025],Point[Pk],Red,Dashed,Thickness[0.012],Opacity[1],Circle[{0,0},1,{0,Pi/2}]}],PlotRange->All, AxesStyle->Thick,LabelStyle->Directive[Bold],AxesLabel->Automatic]

Vorderes Bild von NURBS1   (Link zum Bild)

erste Version, bei der kein kein Viertelkreis herauskommt

Dieters “Kreis”

Pk={{0,1},{(2/3),1},{1,(3/4)},{1,0}};

wk={1,1,(4/3),2};

bb=Thread[Times[wk,{b0[t],b1[t],b2[t],b3[t]}]]

Plus@@bb//Simplify

BSk[t_]:=(bb/(Plus@@bb)).Pk//Simplify

wk

BSk[t]

Die interpolierende Kurve ist jetzt eine mit rationalen Parameterfunktionen. Damit sind prinzipiell auch Kreise, Kegelschnitte usw. erreichbar, die alle eine Parametrisierung mit rationalen Funktionen haben. (Die auf S. 7 ist wirklich der Kreis).

Show[ParametricPlot[BSk[t]//Evaluate,{t,0,1}],     Graphics[{PointSize[0.02],Point[Pk],Line[Pk],Red,Circle[{0,0},1,{0,Pi/2}]}],PlotRange->All]

Dieters “Kreis” + Dörte Vari mit den alten Punkten

Pk={{0,1},{(2/3),1},{1,(3/4)},{1,0}};  (* mit diesem "alten Pk "*)

wkD={1,1,(4/3),3}; wkD2={1,1,(4/3),(1/2)};

bbD=Thread[Times[wkD,{b0[t],b1[t],b2[t],b3[t]}]];
bbD2=Thread[Times[wkD2,{b0[t],b1[t],b2[t],b3[t]}]];

Plus@@bbD//Simplify

Plus@@bbD2//Simplify

BSkD[t_]:=(bbD/(Plus@@bbD)).Pk//Simplify
BSkD2[t_]:=(bbD2/(Plus@@bbD2)).Pk//Simplify

BSkD[t]

BSkD2[t]

Die interpolierende Kurve ist jetzt eine mit rationalen Parameterfunktionen. Damit sind prinzipiell auch Kreise, Kegelschnitte usw. erreichbar, die alle eine Parametrisierung mit rationalen Funktionen haben.

Show[ParametricPlot[BSkD2[t]//Evaluate,{t,0,1},PlotStyle->{Orange}],ParametricPlot[BSkD[t]//Evaluate,{t,0,1}],ParametricPlot[BSk[t]//Evaluate,{t,0,1}, PlotStyle->{Dashed,Green}(*Dieter*)],Graphics[{Green, PointSize[0.02],Point[Pk],Black,Line[Pk],Red,Circle[{0,0},1,{0,Pi/2}]}],PlotRange->All]

Dieters  echter Kreis -Berechnung

wk={1,1,(4/3),2};

bb=Thread[Times[wk,{b0[t],b1[t],b2[t],b3[t]}]]

Plus@@bb//Simplify

Pk (* hier also die entscheidende Änderung *)

BSk[t_]:=(bb/(Plus@@bb)).Pk//Simplify

BSk[t]

Die interpolierende Kurve ist jetzt eine mit rationalen Parameterfunktionen. Damit sind prinzipiell auch Kreise, Kegelschnitte usw. erreichbar, die alle eine Parametrisierung mit rationalen Funktionen haben. (Die auf S. 7 ist wirklich der Kreis).

Show[ParametricPlot[BSk[t]//Evaluate,{t,0,1}],     Graphics[{PointSize[0.02],Point[Pk],Line[Pk],Red,Dashed,Circle[{0,0},1,{0,Pi/2}]}],PlotRange->All]

Ganzer Kreis

b0g[t_]:=(((1-t))^3)

b1g[t_]:=3t (((1-t))^2)

b2g[t_]:=3(t^2)(1-t)

b3g[t_]:=(t^3)

bbg=Thread[Times[wk,{b0g[t],b1g[t],b2g[t],b3g[t]}]]

Plus@@bbg//Simplify

Pk

BSkg[t_]:=(bbg/(Plus@@bbg)).Pk//Simplify

BSkg[t]

ParametricPlot[BSkg[t]//Evaluate,{t,-1000,1000},PlotPoints->500, PlotRange->All]

0

Knoten sind nicht uniform, keine Wiederholungen

(*Quit*)

T={0,1/2,3/4,1,2,4,5,20/3,9};

T={0,1/2,3/4,(6/5),2,(5/2),3,(17/5),(18/5)}

t[i_]:=T[[i+1]]

Bn[i_,0,x_]:=Piecewise[{{1,t[i]≤x<t[i+1]}}]

{Bn[0,0,x],Bn[1,0,x],Bn[2,0,x],Bn[3,0,x],Bn[4,0,x]};

Jetzt die Rekursion,  Verbesserte  Version

Bn[i_,p,x_]:=((x-t[i])/(t[i+p]-t[i]))Bn[i,p-1,x]+((t[i+p+1]-x)/(t[i+p+1]-t[i+1]))Bn[i+1,p-1,x]

Bn[i_,1,x_]:=((x-t[i])/(t[i+1]-t[i]))Bn[i,0,x]+((t[i+2]-x)/(t[i+2]-t[i+1]))Bn[i+1,0,x]

Bn[i_,2,x_]:=((x-t[i])/(t[i+2]-t[i]))Bn[i,1,x]+((t[i+3]-x)/(t[i+3]-t[i+1]))Bn[i+1,1,x]

Bn[i_,3,x_]:=((x-t[i])/(t[i+3]-t[i]))Bn[i,2,x]+((t[i+4]-x)/(t[i+4]-t[i+1]))Bn[i+1,2,x]

Bn[i_,4,x_]:=((x-t[i])/(t[i+4]-t[i]))Bn[i,3,x]+((t[i+5]-x)/(t[i+5]-t[i+1]))Bn[i+1,3,x]

Prüfung der Bilder

Plot[{Bn[0,1,x],Bn[1,1,x],Bn[2,1,x],Bn[0,2,x],Bn[1,2,x],Bn[2,2,x]},{x,0,3}]

Die Zackenkurven B[n[i,1,x] stimmen nun.

{Bn[0,1,x],Bn[1,1,x],Bn[2,1,x],Bn[3,1,x]}

Plot[{Bn[0,1,x],Bn[1,1,x],Bn[2,1,x],Bn[3,1,x]},{x,0,4}]

{Bn[0,2,x],Bn[1,2,x],Bn[2,2,x],Bn[3,2,x]};

Plot[{Bn[0,2,x],Bn[1,2,x],Bn[2,2,x],Bn[3,2,x]},{x,0,5}, PlotStyle->Thick,AxesStyle->Thick,LabelStyle->Bold,PlotRange->All]

Jede ist aus drei Parabeln aufgebaut

{Bn[0,3x],Bn[1,3,x],Bn[2,3,x],Bn[3,3,x], Bn[4,3,x]};

alle3er=Plot[{Bn[0,3,x],Bn[1,3,x],Bn[2,3,x],Bn[3,3,x],Bn[4,3,x]},{x,0,3.7},PlotStyle->Thickness[0.008],PlotRange->All]

So das ist alles wohl so richtig und diffbar.

Tpkte=Table[{T[[i]],0},{i,1,8}]

(*ListPlot[Labeled[#,#]&/@Table[Prime[n],{n,10}],PointLegend[{(Subscript[t, 0]),(Subscript[t, 1]),(Subscript[t, 2]),(Subscript[t, 3]),(Subscript[t, 4]),(Subscript[t, 6]),(Subscript[t, 7]),(Subscript[t, 8])}]*)
Ich wollte mit  deb t beschrifen, hab ich nicht hinbekommen.

Show[alle3er, Graphics[{PointSize[0.02],Blue,Point[{{0,0},{(1/2),0},{(3/4),0},{(6/5),0},{2,0}}],
Orange,Point[{{(1/2),-0.03},{(3/4),-0.03},{(6/5),-0.03},{2,-0.03},{(5/2),-0.03}}],
Green, Point[{{(3/4),-0.055},{(6/5),-0.055},{2,-0.055},{(5/2),-0.055},{3,-0.055}}],
Red,Point[{{(6/5),-0.079},{2,-0.079},{(5/2),-0.079},{3,-0.079},{(17/5),-0.079}}],
RGBColor[0.6,0,0.6],Point[{{2,-0.099},{(5/2),-0.099},{3,-0.099},{(17/5),-0.099},{(18/5),-0.099}}]


}],AxesStyle->Thick, LabelStyle->Directive[Bold]]

Bild im Buch

Knoten sind nicht uniform, mit Wiederholungen

Tnu={1,1,1,1,2,4,4,4,4};

keep[v_]:=If[v==0,0,(1/v)]

t[i_]:=Tnu[[i+1]]

Bnu[i_,0,x_]:=Piecewise[{{1,t[i]≤x<t[i+1]}}]

Die verbesserten Bn

Bn[i_,1,x_]:=((x-t[i])/(t[i+1]-t[i]))Bn[i,0,x]+((t[i+2]-x)/(t[i+2]-t[i+1]))Bn[i+1,0,x]

Bn[i_,2,x_]:=((x-t[i])/(t[i+2]-t[i]))Bn[i,1,x]+((t[i+3]-x)/(t[i+3]-t[i+1]))Bn[i+1,1,x]

Bn[i_,3,x_]:=((x-t[i])/(t[i+3]-t[i]))Bn[i,2,x]+((t[i+4]-x)/(t[i+4]-t[i+1]))Bn[i+1,2,x]

Bn[i_,4,x_]:=((x-t[i])/(t[i+4]-t[i]))Bn[i,3,x]+((t[i+5]-x)/(t[i+5]-t[i+1]))Bn[i+1,3,x]

Dieters Def

Bnu[i_,1,x_]:=keep[t[i+1]-t[i]](x-t[i])Bnu[i,0,x]+keep[t[i+2]-t[i+1]](t[i+2]-x)Bnu[i+1,0,x]

Bnu[i_,2,x_]:=keep[t[i+1]-t[i]](x-t[i])Bnu[i,1,x]+keep[t[i+2]-t[i+1]](t[i+2]-x)Bnu[i+1,1,x]

Bnu[i_,3,x_]:=keep[t[i+2]-t[i]](x-t[i])Bnu[i,2,x]+keep[t[i+3]-t[i+1]](t[i+3]-x)Bnu[i+1,2,x]

Bnu[i_,4,x_]:=keep[t[i+3]-t[i]](x-t[i])Bnu[i,3,x]+keep[t[i+4]-t[i+1]](t[i+4]-x)Bnu[i+1,3,x]

Plot[{Bnu[0,3,x],Bnu[1,3,x],Bnu[2,3,x],Bnu[3,3,x],Bnu[4,3,x]}//Evaluate,{x,0,5},BaseStyle->Thickness[0.01],PlotRange->All]

Plot[{Bnu[0,4,x],Bnu[1,4,x],Bnu[2,4,x],Bnu[3,4,x],Bnu[4,4,x]}//Evaluate,{x,0,5},BaseStyle->Thickness[0.01],PlotRange->All]

Dörtes Def ( nun wird was d’raus)

Bnu[i_,1,x_]:=keep[t[i+1]-t[i]](x-t[i])Bnu[i,0,x]+keep[t[i+2]-t[i+1]](t[i+2]-x)Bnu[i+1,0,x]

Bnu[i_,2,x_]:=keep[t[i+2]-t[i]](x-t[i])Bnu[i,1,x]+keep[t[i+3]-t[i+1]](t[i+3]-x)Bnu[i+1,1,x]

Bnu[i_,3,x_]:=keep[t[i+3]-t[i]](x-t[i])Bnu[i,2,x]+keep[t[i+4]-t[i+1]](t[i+4]-x)Bnu[i+1,2,x]

Bnu[i_,4,x_]:=keep[t[i+4]-t[i]](x-t[i])Bnu[i,3,x]+keep[t[i+5]-t[i+1]](t[i+5]-x)Bnu[i+1,3,x]

Plot[{Bnu[0,3,x],Bnu[1,3,x],Bnu[2,3,x],Bnu[3,3,x],Bnu[4,3,x]}//Evaluate,{x,0,5},BaseStyle->Thickness[0.01],PlotRange->All]

Fläche

pts={{{0,-2,0}, {0,-2,0.5},{0,-1,0.5},{0,-1,0},{0,-1,-0.5},{0,-2,-0.5},{0,-2,0}}, 
 {{2,-2,0}, {2,-2,0.5},{1,-1,0.5},{1,-1,0},{1,-1,-0.5},{2,-2,-0.5},{2,-2,0}}, 
 {{2,2,0}, {2,2,0.5},{1,1,0.5},{1,1,0},{1,1,-0.5},{2,2,-0.5},{2,2,0}}, 
 {{0,2,0}, {0,2,0.5},{0,1,0.5},{0,1,0},{0,1,-0.5},{0,2,-0.5},{0,2,0}}, 
 {{-2,2,0}, {-2,2,0.5},{-1,1,0.5},{-1,1,0},{-1,1,-0.5},{-2,2,-0.5},{-2,2,0}}, 
 {{-2,-2,0}, {-2,-2,0.5},{-1,-1,0.5},{-1,-1,0},{-1,-1,-0.5},{-2,-2,-0.5},{-2,-2,0}},{{0,-2,0}, {0,-2,0.5},{0,-1,0.5},{0,-1,0},{0,-1,-0.5},{0,-2,-0.5},{0,-2,0}}};

w={{1,.5,.5,1,.5,.5,1},{1,.5,.5,1,.5,.5,1}/2,{1,.5,.5,1,.5,.5,1}/2,{1,.5,.5,1,.5,.5,1},{1,.5,.5,1,.5,.5,1}/2,{1,.5,.5,1,.5,.5,1}/2,{1,.5,.5,1,.5,.5,1}};

uk={0,0,0,1/4,1/2,1/2,3/4,1,1,1};

vk={0,0,0,1/4,1/2,1/2,3/4,1,1,1};

Torus aus NURBS

Graphics3D[{
FaceForm[Yellow],Opacity[0.7],PointSize[0.03],
BSplineSurface[pts,SplineKnots->{uk,vk},SplineDegree->2,SplineWeights->w,SplineClosed->{True,True}],Point[Flatten[pts,1]],Line[pts],Line[pts//Transpose]},ViewPoint->{Right,Front},Boxed->False]

NURBS