5
$\begingroup$

I've been working on this for days. I am trying to plot the B-spline 2D curve (figure '8') on the 3D surface. How can I do that? Can anyone help me with this?

Here, I provide code that I use to generate the curve and the surface.

(* pick a data set *)
dataset = 3;

If[dataset == 3, (
   n = 3;  (* degree *)
   ll = 12;  (* domain intervals *)
   numd = n + ll - 1;
   dd = Table[{Cos[x/2] // N, 2 Sin[x] // N}, {x, 0, numd}])];

cpts1 = Table[{i, j, RandomReal[{1, -1}]}, {i, 5}, {j, 5}];

oneside = {{{0, 0, -1}, {0, 1, 0}, {0, 2, 0}, {0, 3, -1}}, {{1, 0, 0}, {1, 1, 0}, {1, 2, 0}, {1, 3,0}},{{2, 0, 0}, {2, 1, 0}, {2, 2, 0}, {2, 3, 0}},                           {{3, 0, -1}, {3, 1, 0}, {3, 2, 0}, {3,3, -1}}};
b = Graphics3D[BSplineSurface[oneside]]
bT = Transpose[b];
Show[Graphics3D[{PointSize[Medium], Black, Map[Point, oneside], Black,
Line[oneside], Line[Transpose[oneside]]}], b]

(*cpts2=Table[{i,j,RandomReal[{-1,1}]},{i,-1,1,2/5},{j,-1,1,2/5}];
ParametricPlot3D[BSplineFunction[cpts2][u,v],{u,0,1},{v,0,1},\
RegionFunction\[Rule](#1^2+#2^2\[LessEqual]1&)]*)



(* uniform knots *)
knot = Join[Table[0, {i, 0, n}], Table[i/ll, {i, 1, ll - 1}], 
Table[1, {i, 0, n}]] // N;
numk = Length[knot];

(* Extract the juntion points *)
(* Evaluate at the domain knots *)
jknots = Table[knot[[i]], {i, n + 1, numk - n, 1}];
jpts = Table[curve[knot[[i]]], {i, n + 1, numk - n, 1}];


(* curve evaluation *)
curve[t_] := Sum[BSplineBasis[{n, knot}, i, t]*dd[[i + 1]], {i, 0, numd}];

(* Plot *)
cplot = ParametricPlot[curve[t], {t, knot[[n + 1]], knot[[numk - n]]},
PlotStyle -> {Thick, Green}];
points = Graphics[{Black, PointSize[0.015], Point[dd], 
PointSize[0.02], Point[dd[[1]]]}];
ddplot = ListLinePlot[dd];
jptsplot = Graphics[{Red, PointSize[0.015], Point[jpts]}];
Show[{ddplot, cplot, points, jptsplot}, Axes -> False]

enter image description here enter image description here

$\endgroup$
  • 2
    $\begingroup$ Can you give the code you used to create both images? This will make it much easier for people to help $\endgroup$ – Dunlop Nov 18 '16 at 18:45
  • $\begingroup$ yeah sure no problem $\endgroup$ – BayWilson Nov 18 '16 at 19:29
  • $\begingroup$ Related: (13735) $\endgroup$ – Mr.Wizard Jul 30 '18 at 4:02
6
$\begingroup$

You can use texture:

texture = 
  Rasterize[
   Show[{ddplot, cplot, points, jptsplot}, Axes -> False, 
    ImageSize -> {300, 300}], "Image"];

f = BSplineFunction[oneside];

Show[Graphics3D[{PointSize[Medium], Black, Map[Point, oneside], Black,
    Line[oneside], Line[Transpose[oneside]]}], 
 ParametricPlot3D[f[x, y], {x, 0, 1}, {y, 0, 1}, 
  PlotStyle -> Texture[Rasterize[t]], Mesh -> None]]

enter image description here

or embedding 2d to 3d:

f8 = Show[{ddplot, cplot, points, jptsplot}];

f83d = (f8[[1]] /. {x_?NumericQ, y_?NumericQ} :> 
     f[Rescale[x, {-1, 1}], Rescale[y, {-2, 2}, {0.25, .75}]]);

Show[Graphics3D[{PointSize[Medium], Black, Map[Point, oneside], Black,
    Line[oneside], Line[Transpose[oneside]]}], 
 Graphics3D[{BSplineSurface[oneside], f83d}]]

enter image description here

| improve this answer | |
$\endgroup$
  • $\begingroup$ That's exactly what I want. Thank you so much. $\endgroup$ – BayWilson Nov 19 '16 at 7:08

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.