Some time ago I created a printable STL-file with a certain software of my own and now I want to modify it with Mathematica programmatically, mainly by subtracting certain geometric objects (e.g. spheres), for example to get a net -like appearance of what was formerly a massive surface.

As a "warm-up" I imported the surface, repaired it to be sure by RepairMesh, and tried to subtract a sphere centered in the origin of radius 1 with RegionDifference.

But I could not get Mathematica do it, trying a lot of variations of using DiscretizeRegion, BoundaryDiscretizeRegion, TriangulateMesh, BoundaryMesh on the arguments of RegionDifference and on its result value. Nothing worked.

Has anyone an idea what else I could try?

Follows an exported png from part of my notebook:

enter image description here

At last a "meta-question": To insert a part of a notebook into a question (or answer) here, is it the right/best way to select the part of the notebook intended for publication and then use File>Save Selection As from Mathematica's "File"-Menu?

As requested I include the above as plain text:

myQuartic = Import["http://www.aviduratas.de/wc/model-scaled-x7.stl", "BoundaryMeshRegion"]
myQuartic1 = RegionResize[myQuartic, {16.0}]
myQuartic1Repair = RepairMesh[myQuartic1]
(* *)

dcr[reg_, pg_:"Quality", mcm_:0.01] := DiscretizeRegion[reg, PerformanceGoal->pg, MaxCellMeasure->mcm]
bdcr[reg_, pg_:"Quality", mcm_:0.01] := BoundaryDiscretizeRegion[reg, PerformanceGoal->pg, MaxCellMeasure->mcm]

DiscretizeRegion[RegionDifference[myQuartic1Repair, bdcr[Ball[{0,0,0},1]]],Table[{-8,8},3], PerformanceGoal->"Quality", MaxCellMeasure->0.01]
(* During evaluation of In[…]: BoundaryMeshRegion::bsuncl: The boundary surface is not closed because the edges Line[{{126567,126563},{254562,254563},{124643,126266},{268387,268383},{255259,255243},{265372,265373},{194888,194887},{254318,254319},{126273,125167},{124916,124913},{97259,97260},{126449,126450},{124908,124913},{193478,193608},<<23>>,{97283,97281},{205986,205978},{254808,254822},{265338,265350},{126409,126417},{125270,125271},{124936,124940},{194837,193519},{255481,255485},{268500,268499},{125367,125383},{124639,124640},{255245,255247},<<1195>>}] only come from a single face. *)
(* During evaluation of In[…]: DiscretizeRegion::drf: DiscretizeRegion was unable to discretize the region BooleanRegion[<<2>>]. *)
(* DiscretizeRegion[BooleanRegion[#1&&!#2&,{,}],{{-8,8},{-8,8},{-8,8}},PerformanceGoal->Quality,MaxCellMeasure->0.01] *)

In the meantime I tried to overcome the problem by defining explicitly an indicator function for regions and a rule to compute this indicator function for region differences, but it did not solve the problem:



charfun[reg_?RegionQ,{x_,y_,z_}] := If[RegionMember[reg,{x,y,z}] == True, 1, 0]
regdiff /: charfun[regdiff[reg1_, reg2_], {x_,y_,z_}] := charfun[reg1, {x,y,z}]  (1-charfun[reg2,{x,y,z}])
ff[{x_?NumericQ, y_?NumericQ, z_?NumericQ}] := 
charfun[regdiff[myQuartic1Repair,Ball[{0,0,0},2]], {x,y,z}]
(* 0 *)

(* (1-If[((x|y|z)∈\[DoubleStruckCapitalR]&&x^2+y^2+z^2<=4)==True,1,0]) If[RegionMember[,{x,y,z}]==True,1,0] *)

data=RandomPoint[Ball[{0,0,0},8], 100000];
Graphics3D[Point[Select[data, ff[#] == 1 &]]]
dcr[ImplicitRegion[Abs[ff[{x,y,z}]-1] < 0.2, {x,y,z}],Table[{-8,8},3]]
(* During evaluation of In[…]: DiscretizeRegion::drf: DiscretizeRegion was unable to discretize the region ImplicitRegion[Abs[-1+ff[{x,y,z}]]<0.2,{x,y,z}]. *)
dcr[ImplicitRegion[ff[{x,y,z}] >= 0.5, {x,y,z}]]
(* During evaluation of In[…]: DiscretizeRegion::drf: DiscretizeRegion was unable to discretize the region ImplicitRegion[ff[{x,y,z}]>=0.5,{x,y,z}].
(* DiscretizeRegion[ImplicitRegion[ff[{x,y,z}]>=0.5,{x,y,z}],PerformanceGoal->Quality,MaxCellMeasure->0.01] *)

The same as picture:

using a self-defined indicator function

How can I find out what the source of the problem is? I am now even pondering the possibility to do the intersection with an external function call either to a Python wrapper of the CGAL library or to a C++ program calling CGAL. But I would really like to avoid going so far.

New contributor
Jürgen Böhm is a new contributor to this site. Take care in asking for clarification, commenting, and answering. Check out our Code of Conduct.
  • 2
    $\begingroup$ Please do not post images of your work, especially when the images display at a size that make them difficult to read. Please post your actual Mathematica code in the form of text that can be copied and pasted into a Mathematica notebook. Without such, it will be difficult to reproduce your problem and to experiment with possible solutions. $\endgroup$ – m_goldberg Nov 8 at 17:42

Your Answer

Jürgen Böhm is a new contributor. Be nice, and check out our Code of Conduct.

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

Browse other questions tagged or ask your own question.