7
$\begingroup$

In Is there a way to outline text?, I was amazed that BoundaryDiscretizeGraphics can discretize a Text primitive. So in a similar way, I wanted to apply DiscretizeGraphics to a Tube like this:

DiscretizeGraphics @ Graphics3D[Tube[{{0, 0, 0}, {1, 1, 1}}, .1]]

or

tube = Tube[{{0, 0, 0}, {1, 1, 1}}, .1];
BoundaryDiscretizeGraphics[tube, #] & /@ {_Tube, _Polygon, _Line, _Point}

But I failed to do it. Is it a bug in Mathematica, or is it some mistake in my code?

$\endgroup$
7
  • $\begingroup$ Tube is not listed among the graphics primitives for BoundaryDiscretizeGraphics. (Neither is Line, to which Tube is related, in my mind.) $\endgroup$
    – Michael E2
    Sep 26, 2015 at 18:09
  • $\begingroup$ Consider discretizing an extrusion obtained from the answers to mathematica.stackexchange.com/questions/3051/… $\endgroup$
    – Michael E2
    Sep 26, 2015 at 18:12
  • $\begingroup$ @MichaelE2 But the Text?? $\endgroup$
    – yode
    Sep 26, 2015 at 18:12
  • $\begingroup$ @MichaelE2 Sure?Don't you acess my link?I have a try just,It's normal.and the address is mathematica.stackexchange.com/questions/8287/… $\endgroup$
    – yode
    Sep 26, 2015 at 18:42
  • $\begingroup$ @MichaelE2 I mean that Text isn't a primitive as you say in first. $\endgroup$
    – yode
    Sep 26, 2015 at 19:11

3 Answers 3

14
$\begingroup$

It took quite a while, but I've finally come up with a way to generate discretized tubes. This again is based on work in this previous answer (from the thread mentioned earlier by Michael). In the interest of keeping things short, I will not be repeating the definitions of orthogonalDirections[], extend[], and crossSection[] from that answer. Here, then, is the tube generator:

makeCap[type : ("Butt" | "Round" | "Square"), s : (-1 | 1), path_?MatrixQ, tube_?ArrayQ,
        r_?NumericQ, h_?NumericQ] := 
    Module[{d = Take[path, 2 s], cs, p, t0, t1},
           cs = tube[[s]];
           t0 = h; t1 = 1 - h Boole[type =!= "Square"];
           If[s == -1, {t0, t1} = {t1, t0}];
           If[type === "Butt",
              {d[[s]], 
               Table[ScalingTransform[{t, t, t}, d[[s]]] @ cs, {t, t0, t1, s h}]},
              p = (s r/(EuclideanDistance @@ d)) ({1, -1}.d);
              {d[[s]] + p, Switch[type,
               "Round",
               Table[Composition[TranslationTransform[p Cos[π t/2]], 
                                 ScalingTransform[{1, 1, 1} Sin[π t/2], d[[s]]]][cs],
                     {t, t0, t1, s h}],
               "Square",
               Table[Composition[TranslationTransform[p],
                                 ScalingTransform[{t, t, t}, d[[s]]]][cs],
                     {t, t0, t1, s h}]]}]]

Options[TubeMesh] = {"CapForm" -> None, "CirclePoints" -> Automatic, 
                     "MeshType" -> Automatic, Tolerance -> Automatic};

TubeMesh[path_?MatrixQ, r_?NumericQ, opts : OptionsPattern[{TubeMesh, MeshRegion}]] := 
    Module[{c0, c1, cf, mt, dims, h, idx, m, n, p0, p1, t0, t1, tol, tube},
           cf = OptionValue["CapForm"]; mt = OptionValue["MeshType"]; 
           If[mt === Automatic, 
              mt = If[MatchQ[cf, "Butt" | "Round" | "Square"], 
                      BoundaryMeshRegion, MeshRegion]];
           tol = OptionValue[Tolerance] /. Automatic -> 0.0015;
           n = OptionValue["CirclePoints"]; 
           If[n === Automatic, n = Round[17 tol^(-1/3)/5 - 57 tol^(1/3)/59]; 
              n += Boole[OddQ[n]]]; h = 2/n;
           tube = FoldList[Function[{p, t},
                                    extend[p, t[[2]], t[[2]] - t[[1]],
                                           orthogonalDirections[t]]], 
                           crossSection[path, r, n], Partition[path, 3, 1, {1, 2}, {}]];
           If[MatchQ[cf, "Butt" | "Round" | "Square"],
              {p0, c0} = makeCap[cf, 1, path, tube, r, h];
              {p1, c1} = makeCap[cf, -1, path, tube, r, h];
              tube = Join[c0, tube, c1]];
           dims = Most[Dimensions[tube]]; tube = Apply[Join, tube];
           m = Times @@ dims; idx = Partition[Range[m], Last[dims]];  t0 = t1 = {};
           If[MatchQ[cf, "Butt" | "Round" | "Square"],
              PrependTo[tube, p0]; AppendTo[tube, p1]; idx += 1;
              t0 = PadLeft[Partition[First[idx], 2, 1], {Automatic, 3}, 1];
              t1 = PadRight[Reverse /@ Partition[Last[idx], 2, 1],
                            {Automatic, 3}, m + 2]];
           mt[tube, Triangle[Join[t0,
                                  Flatten[Apply[{Append[Reverse[#1], Last[#2]], 
                                                 Prepend[#2, First[#1]]} &,
                                  Partition[idx, {2, 2}, {1, 1}], {2}], 2], t1]],
              FilterRules[{opts}, Options[MeshRegion]]]]

As designed, TubeMesh[] will return a MeshRegion[] object for the setting "CapForm" -> None, and a BoundaryMeshRegion[] for the other "CapForm"s.

Using once more the example path in the previous answer:

path = First @ Cases[ParametricPlot3D[
                     BSplineFunction[{{0, 0, 0}, {1, 1, 1}, {2, -1, -1},
                                      {3, 0, 1}, {4, 1, -1}}][u] // Evaluate, {u, 0, 1}, 
                     MaxRecursion -> 1], Line[l_] :> l, ∞];

TubeMesh[path, 1/5, "CapForm" -> "Round", PlotTheme -> "SmoothShading"]

some tube converted into a region

Compute the volume:

Volume[%]
   0.727654081738915
$\endgroup$
1
  • $\begingroup$ Wow,you made it. :) $\endgroup$
    – yode
    Jul 2, 2016 at 21:05
7
$\begingroup$

Since Tube is rendered in the front end, there may be no way to discretize it. But here is a way to generate a tube and discretize it:

DiscretizeGraphics@
 ComputationalGeometry`Methods`GraphicsComplexTube[
  Table[{t, t^2, t^3}, {t, -1, 1, 0.1}], 0.2,
  PlotPoints -> 25, Mesh -> All]

Mathematica graphics

One might do a similar discretization of any of the methods found here: Extruding along a path

$\endgroup$
1
  • $\begingroup$ I'm sorry for accept your answer now because the ComputationalGeometry`Methods`GraphicsComplexTube is not convenience to control.But still now I cannot find a better way to discretize the Tube,So I think it is a best way at present.And thanks for your help. $\endgroup$
    – yode
    Oct 14, 2015 at 9:23
1
$\begingroup$

In the version 11.3, BoundaryDiscretizeGraphics and DiscretizeGraphics both work:

BoundaryDiscretizeGraphics[Graphics3D[Tube[{{0, 0, 0}, {1, 1, 1}}, .1]]]

$\endgroup$

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.