3
$\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.

$\endgroup$
8
$\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

$\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 Oct 24 '20 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 Oct 24 '20 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 Oct 24 '20 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 Oct 25 '20 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 Oct 25 '20 at 10:43
4
$\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

$\endgroup$
1
  • $\begingroup$ @kglr_you were very good representations I congratulate you $\endgroup$ – zeros Oct 24 '20 at 20:01

Your Answer

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

Not the answer you're looking for? Browse other questions tagged or ask your own question.