4 replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/ edited Apr 13 '17 at 12:55 This question follows my initial question that can be found herehere. This question follows my initial question that can be found here. This question follows my initial question that can be found here. 3 deleted 115 characters in body edited Mar 15 '16 at 16:17 sponce 13555 bronze badges coo1 = data.txt maxvalue = Max[coo1[[All, 4]]]*1000; minvalue = Min[coo1[[All, 4]]]*1000; coo2 = {coo1[[1, 1 ;; 4]]}; Do[If[ coo1[[i, 4]] > 0.0 && coo1[[i, 4]] < 0.00165 , { AppendTo[coo2, coo1[[i, 1 ;; 4]]] },], {i, 1, Length[coo1[[All, 1]]]}]; coo2 = Delete[coo2, 1]; coo21 = Select[coo2, #[[3]] < Max[coo1[[All, 3]]]/2 &]; coo22 = Select[coo2, #[[3]] > Max[coo1[[All, 3]]]/2 &]; coo3 = {coo1[[1, 1 ;; 4]]}; Do[If[ coo1[[i, 4]] > 0.00175 && coo1[[i, 4]] < 0.005, { AppendTo[coo3, coo1[[i, 1 ;; 4]]] },], {i, 1, Length[coo1[[All, 1]]]}]; coo3 = Delete[coo3, 1]; coo4 = Select[coo3, #[[3]] < Max[coo1[[All, 3]]]/2 + 0.03 &]; coo5 = Select[coo3, #[[3]] >= Max[coo1[[All, 3]]]/2 - 0.05 &]; coo6 = Select[coo1, #[[4]] > 0.0082 & ]; coo7 = Select[coo6, #[[4]] < 0.0085 & ]; coo8 = Select[coo7, #[[1]] < 0.25 &]; coo9 = Select[coo8, #[[2]] < 0.25 &]; coo10 = Select[coo7, #[[1]] < 0.25 &]; coo11 = Select[coo10, #[[2]] > 0.25 &]; coo12 = Select[coo7, #[[1]] > 0.5 &]; coo13 = Select[coo12, #[[2]] < 1.0 &]; coo14 = Select[coo7, #[[1]] > 0.5 &]; coo15 = Select[coo14, #[[2]] > 1.0 &]; alphaShapes2D[points_, crit_] := Module[{alphacriteria, del = Quiet@DelaunayMesh@points, tetras, tetcoords, tetradii, selectExternalFaces}, alphacriteria[tetrahedra_, radii_, rmax_] := Pick[tetrahedra, UnitStep@Subtract[rmax, radii], 1]; selectExternalFaces[facets_] := MeshRegion[points, facets]; If[Head[del] === EmptyRegion, del, tetras = MeshCells[del, 2]; tetcoords = MeshPrimitives[del, 2][[All, 1]]; tetradii = Quiet@Thread[Circumsphere[tetcoords]][[All, 2]]; selectExternalFaces@alphacriteria[tetras, tetradii, crit]]]; reg = alphaShapes2D[DeleteDuplicates@coo21[[All, ;; 2]], .2] nf = Nearest[coo21[[All, {1, 2, 3}]] -> Rescale[coo21[[All, 4]]]]; colfun = ColorData[{"SunsetColors", {minvalue, maxvalue}}]@"TemperatureMap"]@ First@nf[{#1, #2, #3}] &; p1 = ListPlot3D[coo21[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] reg = alphaShapes2D[DeleteDuplicates@coo22[[All, ;; 2]], .2] nf = Nearest[coo22[[All, {1, 2, 3}]] -> Rescale[coo22[[All, 4]]]]; colfun = ColorData["Rainbow"]@First@nf[ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &; p11 = ListPlot3D[coo22[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] reg = alphaShapes2D[DeleteDuplicates@coo4[[All, ;; 2]], .2] nf = Nearest[coo4[[All, {1, 2, 3}]] -> Rescale[coo4[[All, 4]]]]; colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &; p2 = ListPlot3D[coo4[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10, PlotLegends -> BarLegend[{"TemperatureMap", {minvalue, maxvalue}}, ColorFunctionScaling -> True]] reg = alphaShapes2D[DeleteDuplicates@coo5[[All, ;; 2]], .15] nf = Nearest[coo5[[All, {1, 2, 3}]] -> Rescale[coo5[[All, 4]]]]; colfun = ColorData["Rainbow"]@First@nf[ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &; p3 = ListPlot3D[coo5[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] nf = Nearest[coo7[[All, {1, 2, 3}]] -> Rescale[coo7[[All, 4]]]]; colfun = ColorData[{"TemperatureMap", {minvalue, maxvalue}}]@ColorData["TemperatureMap"]@ First@nf[{#1, #2, #3}] &; p4 = ListSurfacePlot3D[coo9[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p5 = ListSurfacePlot3D[coo11[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p6 = ListSurfacePlot3D[coo13[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p7 = ListSurfacePlot3D[coo15[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; Show[{p1, p11, p2, p3, p4, p5, p6, p7}, PlotRange -> All]  coo1 = data.txt maxvalue = Max[coo1[[All, 4]]]*1000; minvalue = Min[coo1[[All, 4]]]*1000; coo2 = {coo1[[1, 1 ;; 4]]}; Do[If[ coo1[[i, 4]] > 0.0 && coo1[[i, 4]] < 0.00165 , { AppendTo[coo2, coo1[[i, 1 ;; 4]]] },], {i, 1, Length[coo1[[All, 1]]]}]; coo2 = Delete[coo2, 1]; coo21 = Select[coo2, #[[3]] < Max[coo1[[All, 3]]]/2 &]; coo22 = Select[coo2, #[[3]] > Max[coo1[[All, 3]]]/2 &]; coo3 = {coo1[[1, 1 ;; 4]]}; Do[If[ coo1[[i, 4]] > 0.00175 && coo1[[i, 4]] < 0.005, { AppendTo[coo3, coo1[[i, 1 ;; 4]]] },], {i, 1, Length[coo1[[All, 1]]]}]; coo3 = Delete[coo3, 1]; coo4 = Select[coo3, #[[3]] < Max[coo1[[All, 3]]]/2 + 0.03 &]; coo5 = Select[coo3, #[[3]] >= Max[coo1[[All, 3]]]/2 - 0.05 &]; coo6 = Select[coo1, #[[4]] > 0.0082 & ]; coo7 = Select[coo6, #[[4]] < 0.0085 & ]; coo8 = Select[coo7, #[[1]] < 0.25 &]; coo9 = Select[coo8, #[[2]] < 0.25 &]; coo10 = Select[coo7, #[[1]] < 0.25 &]; coo11 = Select[coo10, #[[2]] > 0.25 &]; coo12 = Select[coo7, #[[1]] > 0.5 &]; coo13 = Select[coo12, #[[2]] < 1.0 &]; coo14 = Select[coo7, #[[1]] > 0.5 &]; coo15 = Select[coo14, #[[2]] > 1.0 &]; alphaShapes2D[points_, crit_] := Module[{alphacriteria, del = Quiet@DelaunayMesh@points, tetras, tetcoords, tetradii, selectExternalFaces}, alphacriteria[tetrahedra_, radii_, rmax_] := Pick[tetrahedra, UnitStep@Subtract[rmax, radii], 1]; selectExternalFaces[facets_] := MeshRegion[points, facets]; If[Head[del] === EmptyRegion, del, tetras = MeshCells[del, 2]; tetcoords = MeshPrimitives[del, 2][[All, 1]]; tetradii = Quiet@Thread[Circumsphere[tetcoords]][[All, 2]]; selectExternalFaces@alphacriteria[tetras, tetradii, crit]]]; reg = alphaShapes2D[DeleteDuplicates@coo21[[All, ;; 2]], .2] nf = Nearest[coo21[[All, {1, 2, 3}]] -> Rescale[coo21[[All, 4]]]]; colfun = ColorData[{"SunsetColors", {minvalue, maxvalue}}]@ First@nf[{#1, #2, #3}] &; p1 = ListPlot3D[coo21[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] reg = alphaShapes2D[DeleteDuplicates@coo22[[All, ;; 2]], .2] nf = Nearest[coo22[[All, {1, 2, 3}]] -> Rescale[coo22[[All, 4]]]]; colfun = ColorData["Rainbow"]@First@nf[{#1, #2, #3}] &; p11 = ListPlot3D[coo22[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] reg = alphaShapes2D[DeleteDuplicates@coo4[[All, ;; 2]], .2] nf = Nearest[coo4[[All, {1, 2, 3}]] -> Rescale[coo4[[All, 4]]]]; colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &; p2 = ListPlot3D[coo4[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10, PlotLegends -> BarLegend[{"TemperatureMap", {minvalue, maxvalue}}, ColorFunctionScaling -> True]] reg = alphaShapes2D[DeleteDuplicates@coo5[[All, ;; 2]], .15] nf = Nearest[coo5[[All, {1, 2, 3}]] -> Rescale[coo5[[All, 4]]]]; colfun = ColorData["Rainbow"]@First@nf[{#1, #2, #3}] &; p3 = ListPlot3D[coo5[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] nf = Nearest[coo7[[All, {1, 2, 3}]] -> Rescale[coo7[[All, 4]]]]; colfun = ColorData[{"TemperatureMap", {minvalue, maxvalue}}]@ First@nf[{#1, #2, #3}] &; p4 = ListSurfacePlot3D[coo9[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p5 = ListSurfacePlot3D[coo11[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p6 = ListSurfacePlot3D[coo13[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p7 = ListSurfacePlot3D[coo15[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; Show[{p1, p11, p2, p3, p4, p5, p6, p7}, PlotRange -> All]  coo1 = data.txt maxvalue = Max[coo1[[All, 4]]]*1000; minvalue = Min[coo1[[All, 4]]]*1000; coo2 = {coo1[[1, 1 ;; 4]]}; Do[If[ coo1[[i, 4]] > 0.0 && coo1[[i, 4]] < 0.00165 , { AppendTo[coo2, coo1[[i, 1 ;; 4]]] },], {i, 1, Length[coo1[[All, 1]]]}]; coo2 = Delete[coo2, 1]; coo21 = Select[coo2, #[[3]] < Max[coo1[[All, 3]]]/2 &]; coo22 = Select[coo2, #[[3]] > Max[coo1[[All, 3]]]/2 &]; coo3 = {coo1[[1, 1 ;; 4]]}; Do[If[ coo1[[i, 4]] > 0.00175 && coo1[[i, 4]] < 0.005, { AppendTo[coo3, coo1[[i, 1 ;; 4]]] },], {i, 1, Length[coo1[[All, 1]]]}]; coo3 = Delete[coo3, 1]; coo4 = Select[coo3, #[[3]] < Max[coo1[[All, 3]]]/2 + 0.03 &]; coo5 = Select[coo3, #[[3]] >= Max[coo1[[All, 3]]]/2 - 0.05 &]; coo6 = Select[coo1, #[[4]] > 0.0082 & ]; coo7 = Select[coo6, #[[4]] < 0.0085 & ]; coo8 = Select[coo7, #[[1]] < 0.25 &]; coo9 = Select[coo8, #[[2]] < 0.25 &]; coo10 = Select[coo7, #[[1]] < 0.25 &]; coo11 = Select[coo10, #[[2]] > 0.25 &]; coo12 = Select[coo7, #[[1]] > 0.5 &]; coo13 = Select[coo12, #[[2]] < 1.0 &]; coo14 = Select[coo7, #[[1]] > 0.5 &]; coo15 = Select[coo14, #[[2]] > 1.0 &]; alphaShapes2D[points_, crit_] := Module[{alphacriteria, del = Quiet@DelaunayMesh@points, tetras, tetcoords, tetradii, selectExternalFaces}, alphacriteria[tetrahedra_, radii_, rmax_] := Pick[tetrahedra, UnitStep@Subtract[rmax, radii], 1]; selectExternalFaces[facets_] := MeshRegion[points, facets]; If[Head[del] === EmptyRegion, del, tetras = MeshCells[del, 2]; tetcoords = MeshPrimitives[del, 2][[All, 1]]; tetradii = Quiet@Thread[Circumsphere[tetcoords]][[All, 2]]; selectExternalFaces@alphacriteria[tetras, tetradii, crit]]]; reg = alphaShapes2D[DeleteDuplicates@coo21[[All, ;; 2]], .2] nf = Nearest[coo21[[All, {1, 2, 3}]] -> Rescale[coo21[[All, 4]]]]; colfun = ColorData[{"TemperatureMap"]@ First@nf[{#1, #2, #3}] &; p1 = ListPlot3D[coo21[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] reg = alphaShapes2D[DeleteDuplicates@coo22[[All, ;; 2]], .2] nf = Nearest[coo22[[All, {1, 2, 3}]] -> Rescale[coo22[[All, 4]]]]; colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &; p11 = ListPlot3D[coo22[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] reg = alphaShapes2D[DeleteDuplicates@coo4[[All, ;; 2]], .2] nf = Nearest[coo4[[All, {1, 2, 3}]] -> Rescale[coo4[[All, 4]]]]; colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &; p2 = ListPlot3D[coo4[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10, ColorFunctionScaling -> True]] reg = alphaShapes2D[DeleteDuplicates@coo5[[All, ;; 2]], .15] nf = Nearest[coo5[[All, {1, 2, 3}]] -> Rescale[coo5[[All, 4]]]]; colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &; p3 = ListPlot3D[coo5[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] nf = Nearest[coo7[[All, {1, 2, 3}]] -> Rescale[coo7[[All, 4]]]]; colfun = ColorData["TemperatureMap"]@ First@nf[{#1, #2, #3}] &; p4 = ListSurfacePlot3D[coo9[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p5 = ListSurfacePlot3D[coo11[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p6 = ListSurfacePlot3D[coo13[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p7 = ListSurfacePlot3D[coo15[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; Show[{p1, p11, p2, p3, p4, p5, p6, p7}, PlotRange -> All]  2 added 4924 characters in body edited Mar 15 '16 at 15:55 sponce 13555 bronze badges Edit The code used to split the data and produce the full picture is the following. I was not so keen as to share it as I'm sure its very ugly, inefficient and long. Bear in mind that I started using Mathematica 3 days ago... I'm very happy to improve though.coo1 = data.txt maxvalue = Max[coo1[[All, 4]]]*1000; minvalue = Min[coo1[[All, 4]]]*1000; coo2 = {coo1[[1, 1 ;; 4]]}; Do[If[ coo1[[i, 4]] > 0.0 && coo1[[i, 4]] < 0.00165 , { AppendTo[coo2, coo1[[i, 1 ;; 4]]] },], {i, 1, Length[coo1[[All, 1]]]}]; coo2 = Delete[coo2, 1]; coo21 = Select[coo2, #[[3]] < Max[coo1[[All, 3]]]/2 &]; coo22 = Select[coo2, #[[3]] > Max[coo1[[All, 3]]]/2 &]; coo3 = {coo1[[1, 1 ;; 4]]}; Do[If[ coo1[[i, 4]] > 0.00175 && coo1[[i, 4]] < 0.005, { AppendTo[coo3, coo1[[i, 1 ;; 4]]] },], {i, 1, Length[coo1[[All, 1]]]}]; coo3 = Delete[coo3, 1]; coo4 = Select[coo3, #[[3]] < Max[coo1[[All, 3]]]/2 + 0.03 &]; coo5 = Select[coo3, #[[3]] >= Max[coo1[[All, 3]]]/2 - 0.05 &]; coo6 = Select[coo1, #[[4]] > 0.0082 & ]; coo7 = Select[coo6, #[[4]] < 0.0085 & ]; coo8 = Select[coo7, #[[1]] < 0.25 &]; coo9 = Select[coo8, #[[2]] < 0.25 &]; coo10 = Select[coo7, #[[1]] < 0.25 &]; coo11 = Select[coo10, #[[2]] > 0.25 &]; coo12 = Select[coo7, #[[1]] > 0.5 &]; coo13 = Select[coo12, #[[2]] < 1.0 &]; coo14 = Select[coo7, #[[1]] > 0.5 &]; coo15 = Select[coo14, #[[2]] > 1.0 &]; alphaShapes2D[points_, crit_] := Module[{alphacriteria, del = Quiet@DelaunayMesh@points, tetras, tetcoords, tetradii, selectExternalFaces}, alphacriteria[tetrahedra_, radii_, rmax_] := Pick[tetrahedra, UnitStep@Subtract[rmax, radii], 1]; selectExternalFaces[facets_] := MeshRegion[points, facets]; If[Head[del] === EmptyRegion, del, tetras = MeshCells[del, 2]; tetcoords = MeshPrimitives[del, 2][[All, 1]]; tetradii = Quiet@Thread[Circumsphere[tetcoords]][[All, 2]]; selectExternalFaces@alphacriteria[tetras, tetradii, crit]]]; reg = alphaShapes2D[DeleteDuplicates@coo21[[All, ;; 2]], .2] nf = Nearest[coo21[[All, {1, 2, 3}]] -> Rescale[coo21[[All, 4]]]]; colfun = ColorData[{"SunsetColors", {minvalue, maxvalue}}]@ First@nf[{#1, #2, #3}] &; p1 = ListPlot3D[coo21[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] reg = alphaShapes2D[DeleteDuplicates@coo22[[All, ;; 2]], .2] nf = Nearest[coo22[[All, {1, 2, 3}]] -> Rescale[coo22[[All, 4]]]]; colfun = ColorData["Rainbow"]@First@nf[{#1, #2, #3}] &; p11 = ListPlot3D[coo22[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] reg = alphaShapes2D[DeleteDuplicates@coo4[[All, ;; 2]], .2] nf = Nearest[coo4[[All, {1, 2, 3}]] -> Rescale[coo4[[All, 4]]]]; colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &; p2 = ListPlot3D[coo4[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10, PlotLegends -> BarLegend[{"TemperatureMap", {minvalue, maxvalue}}, ColorFunctionScaling -> True]] reg = alphaShapes2D[DeleteDuplicates@coo5[[All, ;; 2]], .15] nf = Nearest[coo5[[All, {1, 2, 3}]] -> Rescale[coo5[[All, 4]]]]; colfun = ColorData["Rainbow"]@First@nf[{#1, #2, #3}] &; p3 = ListPlot3D[coo5[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] nf = Nearest[coo7[[All, {1, 2, 3}]] -> Rescale[coo7[[All, 4]]]]; colfun = ColorData[{"TemperatureMap", {minvalue, maxvalue}}]@ First@nf[{#1, #2, #3}] &; p4 = ListSurfacePlot3D[coo9[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p5 = ListSurfacePlot3D[coo11[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p6 = ListSurfacePlot3D[coo13[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p7 = ListSurfacePlot3D[coo15[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; Show[{p1, p11, p2, p3, p4, p5, p6, p7}, PlotRange -> All]  Edit The code used to split the data and produce the full picture is the following. I was not so keen as to share it as I'm sure its very ugly, inefficient and long. Bear in mind that I started using Mathematica 3 days ago... I'm very happy to improve though.coo1 = data.txt maxvalue = Max[coo1[[All, 4]]]*1000; minvalue = Min[coo1[[All, 4]]]*1000; coo2 = {coo1[[1, 1 ;; 4]]}; Do[If[ coo1[[i, 4]] > 0.0 && coo1[[i, 4]] < 0.00165 , { AppendTo[coo2, coo1[[i, 1 ;; 4]]] },], {i, 1, Length[coo1[[All, 1]]]}]; coo2 = Delete[coo2, 1]; coo21 = Select[coo2, #[[3]] < Max[coo1[[All, 3]]]/2 &]; coo22 = Select[coo2, #[[3]] > Max[coo1[[All, 3]]]/2 &]; coo3 = {coo1[[1, 1 ;; 4]]}; Do[If[ coo1[[i, 4]] > 0.00175 && coo1[[i, 4]] < 0.005, { AppendTo[coo3, coo1[[i, 1 ;; 4]]] },], {i, 1, Length[coo1[[All, 1]]]}]; coo3 = Delete[coo3, 1]; coo4 = Select[coo3, #[[3]] < Max[coo1[[All, 3]]]/2 + 0.03 &]; coo5 = Select[coo3, #[[3]] >= Max[coo1[[All, 3]]]/2 - 0.05 &]; coo6 = Select[coo1, #[[4]] > 0.0082 & ]; coo7 = Select[coo6, #[[4]] < 0.0085 & ]; coo8 = Select[coo7, #[[1]] < 0.25 &]; coo9 = Select[coo8, #[[2]] < 0.25 &]; coo10 = Select[coo7, #[[1]] < 0.25 &]; coo11 = Select[coo10, #[[2]] > 0.25 &]; coo12 = Select[coo7, #[[1]] > 0.5 &]; coo13 = Select[coo12, #[[2]] < 1.0 &]; coo14 = Select[coo7, #[[1]] > 0.5 &]; coo15 = Select[coo14, #[[2]] > 1.0 &]; alphaShapes2D[points_, crit_] := Module[{alphacriteria, del = Quiet@DelaunayMesh@points, tetras, tetcoords, tetradii, selectExternalFaces}, alphacriteria[tetrahedra_, radii_, rmax_] := Pick[tetrahedra, UnitStep@Subtract[rmax, radii], 1]; selectExternalFaces[facets_] := MeshRegion[points, facets]; If[Head[del] === EmptyRegion, del, tetras = MeshCells[del, 2]; tetcoords = MeshPrimitives[del, 2][[All, 1]]; tetradii = Quiet@Thread[Circumsphere[tetcoords]][[All, 2]]; selectExternalFaces@alphacriteria[tetras, tetradii, crit]]]; reg = alphaShapes2D[DeleteDuplicates@coo21[[All, ;; 2]], .2] nf = Nearest[coo21[[All, {1, 2, 3}]] -> Rescale[coo21[[All, 4]]]]; colfun = ColorData[{"SunsetColors", {minvalue, maxvalue}}]@ First@nf[{#1, #2, #3}] &; p1 = ListPlot3D[coo21[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] reg = alphaShapes2D[DeleteDuplicates@coo22[[All, ;; 2]], .2] nf = Nearest[coo22[[All, {1, 2, 3}]] -> Rescale[coo22[[All, 4]]]]; colfun = ColorData["Rainbow"]@First@nf[{#1, #2, #3}] &; p11 = ListPlot3D[coo22[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] reg = alphaShapes2D[DeleteDuplicates@coo4[[All, ;; 2]], .2] nf = Nearest[coo4[[All, {1, 2, 3}]] -> Rescale[coo4[[All, 4]]]]; colfun = ColorData["TemperatureMap"]@First@nf[{#1, #2, #3}] &; p2 = ListPlot3D[coo4[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10, PlotLegends -> BarLegend[{"TemperatureMap", {minvalue, maxvalue}}, ColorFunctionScaling -> True]] reg = alphaShapes2D[DeleteDuplicates@coo5[[All, ;; 2]], .15] nf = Nearest[coo5[[All, {1, 2, 3}]] -> Rescale[coo5[[All, 4]]]]; colfun = ColorData["Rainbow"]@First@nf[{#1, #2, #3}] &; p3 = ListPlot3D[coo5[[All, 1 ;; 3]], RegionFunction -> Function[{x, y, z}, RegionMember[reg, {x, y}]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 100, BoxRatios -> Automatic, Mesh -> 10] nf = Nearest[coo7[[All, {1, 2, 3}]] -> Rescale[coo7[[All, 4]]]]; colfun = ColorData[{"TemperatureMap", {minvalue, maxvalue}}]@ First@nf[{#1, #2, #3}] &; p4 = ListSurfacePlot3D[coo9[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p5 = ListSurfacePlot3D[coo11[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p6 = ListSurfacePlot3D[coo13[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; p7 = ListSurfacePlot3D[coo15[[All, 1 ;; 3]], ColorFunction -> colfun, ColorFunctionScaling -> False, MaxPlotPoints -> 10, Mesh -> 5]; Show[{p1, p11, p2, p3, p4, p5, p6, p7}, PlotRange -> All]  1 asked Mar 15 '16 at 15:26 sponce 13555 bronze badges