6
$\begingroup$

I need to create this image bigger with that coloring, and also as a mesh or wire structure, please help me. Image

I tried to connect the dots, but it didn't work and I deleted it

There is some command that scans the image and extracts the points from it.

Improve this question
$\endgroup$
1
  • $\begingroup$ Related link $\endgroup$
    – chyanog
    Commented Apr 24, 2022 at 11:50

3 Answers 3

Reset to default
12
$\begingroup$

Update

Mesh

Clear;
all = Tuples[{0, 1, 2}, 3];
erase = Tuples[{0, 2}, 3];
rest = Complement[all, erase];
Graphics3D[{Lighting -> "Accent", EdgeForm[Blue], FaceForm[], 
  Cuboid[#] & /@ rest}, Boxed -> False]

enter image description here

Solid

Clear;
all = Tuples[{0, 1, 2}, 3];
erase = Tuples[{0, 2}, 3];
rest = Complement[all, erase];
Graphics3D[Cuboid[#] & /@ rest, PlotRange -> All]

enter image description here

2D

BTW,we can also draw the 2D version.

Clear;
all = Tuples[{0, 1, 2}, 2];
erase = Tuples[{0, 2}, 2];
rest = Complement[all, erase];
Graphics[{EdgeForm[Blue], FaceForm[Opacity[0.1]], 
  Rectangle[#] & /@ rest}]

Original

Clear;
vertexs = Tuples[{-3, 3}, 3];
ineqs = Norm[{x, y, z} - #, ∞] >= 2 & /@ vertexs
reg = RegionPlot3D[And @@ ineqs, {x, -3, 3}, {y, -3, 3}, {z, -3, 3}, 
  Lighting -> "Accent", PlotPoints -> 80, Mesh -> None, 
  PlotStyle -> Gray, BoundaryStyle -> {Thick, White}, Boxed -> False, 
  Axes -> False]
(*Needs["NDSolve`FEM`"]
reg // DiscretizeGraphics // ToElementMesh
%["Wireframe"]*)

enter image description here

Improve this answer
$\endgroup$
6
  • 1
    $\begingroup$ @cvgmt_The first image was fantastic, the second I do not know how you achieved it but my idea was something else, something like this image.shutterstock.com/image-vector/… but without the points, you could make some modifications to the code to make it like the example, thanks for your time. $\endgroup$
    – zeros
    Commented Oct 24, 2020 at 2:27
  • $\begingroup$ @cvgmt_I am very good, in the first code that you wrote something you modified because the edges were rounded not with white lines (you could put the initial code that you said that it was necessary to improve, I did not record it) $\endgroup$
    – zeros
    Commented Oct 24, 2020 at 19:59
  • $\begingroup$ @zeros you can remove BoundaryStyle -> {Thick, White} just like vertexs = Tuples[{-3, 3}, 3]; ineqs = Norm[{x, y, z} - #, ∞] >= 2 & /@ vertexs reg = RegionPlot3D[And @@ ineqs, {x, -3, 3}, {y, -3, 3}, {z, -3, 3}, Lighting -> "Accent", PlotPoints -> 80, Mesh -> None, PlotStyle -> Gray,Boxed -> False, Axes -> False] $\endgroup$
    – cvgmt
    Commented Oct 24, 2020 at 23:20
  • $\begingroup$ I made the change in the code you proposed but I got errors,I don't know what I'm doing wrong,I have checked it several times $\endgroup$
    – zeros
    Commented Oct 25, 2020 at 1:15
  • $\begingroup$ vertexs = Tuples[{-3, 3}, 3]; ineqs = Table[ Norm[{x, y, z} - pt, ∞] >= 2 , {pt, vertexs}]; reg = RegionPlot3D[And @@ ineqs, {x, -3, 3}, {y, -3, 3}, {z, -3, 3}, Lighting -> "Accent", PlotPoints -> 80, Mesh -> None, PlotStyle -> Gray, BoundaryStyle -> {Thick, White}, Boxed -> False, Axes -> False] $\endgroup$
    – cvgmt
    Commented Oct 25, 2020 at 10:43
7
$\begingroup$ 
rp = RegionPlot3D[RegionDifference[Cuboid[], CantorMesh[1, 3]], 
  Lighting -> "Neutral", Boxed -> False, PlotTheme -> "Monochrome", ImageSize -> Large]

enter image description here

coords = DeleteCases[_List?(FreeQ[1/3 | 2/3])] @ Tuples[Subdivide[3], 3];

nng = Show[NearestNeighborGraph[coords, VertexSize -> 0, 
    VertexCoordinates -> coords, ImageSize -> Large]] /. 
        Tube[x_, ___] :> {Thick, Black, Line[x]}

enter image description here

Show[rp, nng]

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ @kglr_you were very good representations I congratulate you $\endgroup$
    – zeros
    Commented Oct 24, 2020 at 20:01
6
$\begingroup$

Based on ArrayMesh

ArrayMesh[Normal@SparseArray[Tuples[{1, 3}, 3] -> 0, {3, 3, 3}, 1]] //
   BoundaryDiscretizeRegion // Region`Mesh`MergeCells

enter image description here
The previous answer

reg=BoundaryDiscretizeGraphics[RegionUnion[Cuboid/@Complement[Tuples[{0,1,2},3],
  Tuples[{0,2},3]]]]//Region`Mesh`MergeCells;

Graphics3D[{{Opacity[0.8],reg},{Red,Tube@@@MeshPrimitives[reg,1]}}]

enter image description here

Related
2013 AMC 10A Problems/Problem 14

A solid cube of side length $1$ is removed from each corner of a solid cube of side length $3$. How many edges does the remaining solid have?
enter image description here

Length[MeshPrimitives[reg, 1]]

84

Improve this answer
$\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.