Convert Graphics3D containing BSpline to polygon primitives for export to 3DS?

Question

Graphics3D[] objects created with BSpline functions will not export to 3DS format, which only supports the more basic primitives. Is there any straightforward way to get at an underlying polygon representation of the BSplineSurface[] graphics "primitive" (in quotes because its not very primitive)?

An example is the final 'pipe' example in the documentation ref/BSplineSurface. If you try Export["Pipe.3ds", %], you get an error.

In my particular case I'm creating arbitrary 'surface of revolution' objects as per the "Potter's Wheel" demonstration, where the cross section is determined by a BSpline with dynamic control points. That works fine, but then I need export the resulting objects to another program.

Answer 1

I don't know what you'll count as "straightforward", but...

(* data for B-spline surface, from example in docs *)
pts = {{{0.5, 0, -0.5}, {0, 0, -0.5}, {0, 1, -0.5}, {0.5, 1, -0.5}, {1, 1, -0.5},
        {1, 0, -0.5}, {0.5, 0, -0.5}}, 
       {{0.5, 0, 0.7}, {0, 0, 0.7}, {0, 1, 0.7}, {0.5, 1, 0.7}, {1, 1, 0.7},
        {1, 0, 0.7}, {0.5, 0, 0.7}}, 
   {{0.5, 0, 0.9}, {0, 0, 0.9}, {0, 1, 1.5}, {0.5, 1, 1.5}, {1, 1, 1.5},
    {1, 0, 0.9}, {0.5, 0, 0.9}}, 
   {{0.5, -0.1, 1}, {0, -0.1, 1}, {0, 0.5, 2}, {0.5, 0.5, 2}, {1, 0.5, 2},
    {1, -0.1, 1}, {0.5, -0.1, 1}}, 
   {{0.5, -0.3, 1}, {0, -0.3, 1}, {0, -0.3, 2}, {0.5, -0.3, 2},
    {1, -0.3, 2}, {1, -0.3, 1}, {0.5, -0.3, 1}}, 
   {{0.5, -1.5, 1}, {0, -1.5, 1}, {0, -1.5, 2}, {0.5, -1.5, 2},
    {1, -1.5, 2}, {1, -1.5, 1}, {0.5, -1.5, 1}}};
w = {{1, .5, .5, 1, .5, .5, 1}, {1, .5, .5, 1, .5, .5, 1},
     {1, .5, .5, 1, .5, .5, 1}, {1, .5, .5, 1, .5, .5, 1},
     {1, .5, .5, 1, .5, .5, 1}, {1, .5, .5, 1, .5, .5, 1}};
uk = {0, 0, 0, 1/4, 1/2, 3/4, 1, 1, 1};
vk = {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1};

Graphics3D[BSplineSurface[pts, SplineKnots -> {uk, vk}, SplineDegree -> 2, 
                          SplineWeights -> w, SplineClosed -> {False, True}]] /. 
           bs : BSplineSurface[pts_?ArrayQ, opts___] :> 
           Module[{bsf = BSplineFunction[pts, opts]}, 
                  Cases[Normal[Cases[ParametricPlot3D[bsf[u, v], {u, 0, 1}, {v, 0, 1}],
                        _GraphicsComplex, ∞]], _Polygon, ∞]]

You can check that the output is composed entirely of Polygon[] objects. If need be, you can tweak the options within ParametricPlot3D[].

---

From the comments, it was asked how one might do a version where the sampling is uniform and the polygons are quadrilaterals. The old version of ParametricPlot3D[] did something like that. Here's how I'd emulate it:

MakePolygons[vl_] /; ArrayQ[vl, 3] := Module[{dims = Most[Dimensions[vl]]}, 
  GraphicsComplex[Apply[Join, vl], Polygon[Flatten[Apply[Join[#1, Reverse[#2]] &, 
                  Partition[Partition[Range[Times @@ dims], Last[dims]], {2, 2}, {1, 1}],
                        {2}], 1]]]]

Graphics3D[BSplineSurface[pts, SplineKnots -> {uk, vk}, SplineDegree -> 2, 
                          SplineWeights -> w, SplineClosed -> {False, True}]] /. 
           bs : BSplineSurface[pts_?ArrayQ, opts___] :> 
           Module[{bsf = BSplineFunction[pts, opts], upts = 30, vpts = 18}, 
                  Cases[Normal[MakePolygons[
                        Table[bsf[u, v], {u, 0, 1, 1/(upts - 1)}, {v, 0, 1, 1/(vpts - 1)}]
                        ]], _Polygon, ∞]]