9
$\begingroup$

In their answers to

Creating sculptural forms

The respondents showed how to envelop space curves with a net-like structure. I used kglr's answer to create the following function:

Envelopment[fn_, pr_, le_, tr_, me_] :=

 Show[
   ParametricPlot3D[fn[pr Pi t], {t, 0, 1},
   Axes -> False,
   Background -> Black,
   Boxed -> False,
   ImageSize -> Large,
   Lighting -> "ThreePoint",
   PlotRange -> All,
   PlotStyle -> Directive[{MaterialShading[{"Glazed", Red}], Tube[tr]}]],
  
  ParametricPlot3D[
   v fn[pr Pi t] + (1 - v) fn[pr Pi (t + le)], {t, 0, 1}, {v, 0, 1},
   BoundaryStyle -> Directive[White, Thin],
   Mesh -> {me},
   MeshFunctions -> {#4&},
   MeshStyle -> Directive[White, Thin],
   PlotStyle -> FaceForm[]],

  SphericalRegion -> True]

We use KnotData to create an anonymous function:

knot = KnotData[{3, 1}, "SpaceCurve"]

{Sin[#1] + 2 Sin[2 #1], Cos[#1] - 2 Cos[2 #1], -Sin[3 #1]} &

Envelopment[knot, 4, 0.06, 0.05, 300]

enter image description here

For testing purposes, I included two more curves.

noeud = {2 Cos[#] - 2 Cos[3 #], 2 Sin[#] + 2 Sin[3 #], Sin[4 #]} &;

Envelopment[noeud, 4, 0.05, 0.08, 250]

enter image description here

conical = {# Cos[3 #] - 1, # Sin[3 #], #} &;

Envelopment[conical, 3, 0.06, 0.2, 300]

enter image description here

My question

I want to replace the mesh lines with a semi-transparent coloured band following the curve path. Approximately like in this image, which I found by chance on the internet:

enter image description here

How can we achieve this - optionally with or without the tube?

$\endgroup$
1
  • 1
    $\begingroup$ Thanks for editing, @user84456 $\endgroup$
    – eldo
    Jan 14 at 17:18

2 Answers 2

11
$\begingroup$
ClearAll[curveToStrip, parametricStrip]

curveToStrip[f_, sw_ : 1] := f[#] +
  sw  ( 1 - #2)/ 2  (FrenetSerretSystem[f[$u], $u][[2, 2]] /. $u -> #) &

parametricStrip[opts : OptionsPattern[]][f_, sw_: 1, sc_: 2 Pi, tr_ : .05] :=
 ParametricPlot3D[
  Evaluate[curveToStrip[f, sw][sc  t, v]], 
  {t, 0, 1}, {v, 0, 1},
  opts, 
  BoundaryStyle -> None, 
  MeshFunctions -> {#5 &} , 
  Mesh -> {{0, 1}}, 
  Method -> {"BoundaryOffset" -> False}, 
  MeshStyle -> {MaterialShading[{"Glazed", LightBlue}], Tube[tr]}, 
  Lighting -> "ThreePoint", 
  PlotPoints -> 120, 
  PlotStyle -> MaterialShading[{"Glazed", Red}], 
  Axes -> False, 
  Boxed -> False, 
  ImageSize -> Large, 
  Background -> Black, 
  SphericalRegion -> True]

Examples:

knot = KnotData[{3, 1}, "SpaceCurve"];

parametricStrip[][knot]

enter image description here

Use the option Mesh to specify multiple mesh lines with different styles:

parametricStrip[Mesh -> 
  {{{0, {MaterialShading[{"Glazed", Green}], Tube[.05]}},
   {1/2, {MaterialShading[{"Glazed", White}], Tube[.1]}}, 
   {1, {MaterialShading["Gold"], Tube[.05]}}}}][knot, 3/2]

enter image description here

parametricStrip[Mesh -> None,
  PlotStyle -> Automatic, 
  ColorFunction -> (ColorData["TemperatureMap"][#4] &), 
  "Extrusion" -> .5 ][knot]

enter image description here

Replace "Extrusion" -> .5 with PlotTheme -> "ThickSurface" to get

enter image description here

noeud = {2 Cos[#] - 2 Cos[3 #], 2 Sin[#] + 2 Sin[3 #], Sin[4 #]} &;

parametricStrip[PlotStyle -> MaterialShading["Gold"]][noeud]

enter image description here

conical = {# Cos[3 #] - 1, # Sin[3 #], #} &;

parametricStrip[ViewPoint -> {-3, -1, 1}][conical, #/2]

enter image description here

$\endgroup$
3
  • 1
    $\begingroup$ +1 for the Tube[tr] bit, didn't know! $\endgroup$
    – SHuisman
    Jan 15 at 8:07
  • 1
    $\begingroup$ Thank you, kglr, a wonderful solution. Please add for future reference: Eliminate MeshStyle->..., Lighting->... and PlotStyle->... and add ColorFunction -> "TemperatureMap" and PlotTheme -> "ThickSurface" $\endgroup$
    – eldo
    Jan 15 at 8:17
  • $\begingroup$ @eldo, added a couple of examples per your suggestion. $\endgroup$
    – kglr
    Jan 15 at 8:30
2
$\begingroup$

Try:

Envelopment[fn_, pr_, le_, tr_, me_] := 
 Show[ParametricPlot3D[fn[pr Pi t], {t, 0, 1}, Axes -> False, 
   Background -> Black, Boxed -> False, ImageSize -> Large, 
   Lighting -> "ThreePoint", PlotRange -> All], 
  ParametricPlot3D[
   v fn[pr Pi t] + (1 - v) fn[pr Pi (t + le)], {t, 0, 1}, {v, 0, 1}, 
   BoundaryStyle -> Directive[White, Thin], 
   PlotStyle -> {Opacity[0.2], Red}], SphericalRegion -> True]
$\endgroup$
0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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