Skip to main content

Transform native plot function

Decomposition

Using the output of standard plotting functions, we craft a dynamic version. For example,

Download original notebook
model = RevolutionPlot3D[{Sin[t] + Sin[5 t] /10,
   Cos[t] + Cos[5 t] /10}, {t, 0, Pi},
  RegionFunction -> (Sin[5 (#4 + #5)] > 0 &), Mesh -> None,
  BoundaryStyle -> Black, PlotStyle -> Thickness[.1], MaxRecursion->1]
(*VB[*)(FrontEndRef["d434b057-6d17-4483-a975-bebc4bc9e8d3"])(*,*)(*"1:eJxTTMoPSmNkYGAoZgESHvk5KRCeEJBwK8rPK3HNS3GtSE0uLUlMykkNVgEKp5gYmyQZmJrrmqUYmuuamFgY6yZampvqJqUmJZskJVumWqQYAwB71RWt"*)(*]VB*)

Here we can see that no matter how we change the parameters of the curve, our graphic is packed into a single GraphicsComplex.

Cases[model, _GraphicsComplex, 3] // First // Short 
GraphicsComplex[{{3.639180084066151`*^-7,1.6346410098583916`*^-13,1.1499999999999044`},{0.3372026534904982`,1.5143515717752036`*^-7,1.0618546140245668`},<<7121>>},<<1>>]

And 3 groups of polygons are stored in the list of the second argument.

Cases[Cases[model, _GraphicsComplex, 3][[1,2]], _Polygon, 7] // Short 
{Polygon[{{1224,1026,261},{1281,430,337},{982,541,248},<<5578>>}],<<1>>}

We can select them and construct a dynamic version of RevolutionPlot3D.

Making Dynamic Version

Now let's define vertex and index symbols and a function to update them.

normals;
vertices;
indices1;
indices2;

updateFigure[model_] := With[{
  complex = Cases[model, _GraphicsComplex, 3, 1][[1]]
},
  With[{polygons = Cases[complex[[2]], _Polygon, 7][[All,1]]},
    {indices1, indices2} = {polygons[[1]], polygons[[2]]};
    (* we discarded the 3rd set of polygons, 
      since it is small and only highlights the edges *)

    normals = complex[[3,2]];
    vertices = complex[[1]];
  ]  
];

updateFigure[model];

Now let's connect some sliders.

updateModel[s_:5, a_:0.1] := RevolutionPlot3D[{Sin[t] + Sin[s t] a,
   Cos[t] + Cos[s t] a}, {t, 0, Pi},
  RegionFunction -> (Sin[5 (#4 + #5)] > 0 &), Mesh -> None,
  BoundaryStyle -> Black, PlotStyle -> Thickness[.1], MaxRecursion->1]

sliders = EventHandler[InputGroup[<|
  "s" -> InputRange[1,10,1, "Label"->"s"],
  "a" -> InputRange[0.1, 0.5, 0.1, 0.1, "Label"->"a"]
|>], Function[values,
  model = updateModel @@ Values[values];
  updateFigure[model];
]];

Now our dynamic 3D scene.

{
  Graphics3D[GraphicsComplex[vertices // Offload, {
    Polygon[indices1 // Offload],
    Polygon[indices2 // Offload]
  }, VertexNormals->Offload[normals, "Static"->True]], ImageSize->Medium],

  sliders
} // Row 
(*GB[*){{(*VB[*)(Graphics3D[GraphicsComplex[Offload[vertices], {Polygon[Offload[indices1]], Polygon[Offload[indices2]]}, VertexNormals -> Offload[normals, "Static" -> True]], ImageSize -> Medium])(*,*)(*"1:eJyVT1sKwjAQrA98gXgGj6AeQUEFX7Tif2w2NZB0S7aV6undWMUi/vgzzM7OTDbjM4aqEQQBtRlWaKRq+mnAsHQiu+iYZgvV8tqops3RZgbKKtpl2CtlUEjqMb+Cy3UMVFX54o2m/OM9oLklmP4O61T67OQ/+/TzVlgYoCGTE58B5Q6dFeZ1Sz3teVpfvsNRh0mUC/7DUzu6Ar7q+0zWViQQ6TuQ929B6sI+AOdgTwE="*)(*]VB*)(*|*),(*|*)(*VB[*)(EventObject[<|"Id" -> "55f0f07c-3f5f-4460-92e9-2c79a64df756", "Initial" -> <|"s" -> 6, "a" -> 0.1|>, "View" -> "84fdd81c-0763-412a-be07-9e24147a3cdf"|>])(*,*)(*"1:eJxTTMoPSmNkYGAoZgESHvk5KRCeEJBwK8rPK3HNS3GtSE0uLUlMykkNVgEKW5ikpaRYGCbrGpibGeuaGBol6ialGpjrWqYamRiamCcaJ6ekAQCBVhWg"*)(*]VB*)}}(*]GB*)

Viola!

note

Due to performance reasons we published a static version here (docs you are reading now). Please download this notebook to try it out

Bonus 1: export as STL

If this is running on the web, you might need to implement a download function in JavaScript, since there will be no files API available. However, here we shall stick to the easiest way

export[_] := Then[SystemDialogInputAsync["FileSave", {Null, {"STL Formats" -> {"*.stl"}}}], Function[path,
  If[StringQ[path],
    Export[path, model];
    Beep[];
  ]
]];
EventHandler[InputButton["Export"], export]
(*VB[*)(EventObject[<|"Id" -> "aba8526e-1719-406f-992e-6d24d1cd4026", "Initial" -> False, "View" -> "4e592d40-bec6-447d-bc35-be7c494ddd82"|>])(*,*)(*"1:eJxTTMoPSmNkYGAoZgESHvk5KRCeEJBwK8rPK3HNS3GtSE0uLUlMykkNVgEKm6SaWhqlmBjoJqUmm+mamJin6CYlG5sCuebJJpYmKSkpFkYAiLcWDA=="*)(*]VB*)

Bonus 2: Making a standalone app

Taking all of this together, we can export it as a standalone widget. For that, we need to:

  1. Define initialization cells
  2. Put the output code of the widget into the last input cell of the notebook
  3. Click Share and export to widget

tip

In this notebook, the first two steps are complete. You only need to export it to the WLJS Widget format.

For the output, we use .wlx cells since they allow more styling options using pure HTML and CSS for the final look of the app.

.wlx

With[{
  Preview = Graphics3D[GraphicsComplex[vertices // Offload, {
    Polygon[indices1 // Offload],
    Polygon[indices2 // Offload]
  }, VertexNormals->Offload[normals, "Static"->True]], ImageSize->Medium],

  Sliders = sliders,
  ExportButton = EventHandler[InputButton["Export"], export]
},

  <div class="bg-white p-4 w-full h-full">
    <div class="flex flex-row gap-x-2 justify-between">
      <Preview/>
      <div class="flex flex-col gap-y-3 justify-between">
        <Sliders/>
        <ExportButton/>
      </div>
    </div>
  </div>
]

Demonstration video

Here is how it looks in action 🧙🏼‍♂️