Pasting my DATAC60 to make sure I copy pasted it right:
DATAC60= {{-3.45748,-0.359351,-0.581443},{-3.45748,0.359351,0.581443},{-3.00838,-1.74153,-0.581443},{-3.00838,-0.258779,1.8177},{-3.00838,0.258779,-1.8177},{-3.00838,1.74153,0.581443},{-2.58594,-2.32298,0.581443},{-2.58594,-1.55893,1.8177},{-2.58594,1.55893,-1.8177},{-2.58594,2.32298,-0.581443},{-2.28173,-1.97764,-1.8177},{-2.28173,-0.741377,-2.58176},{-2.28173,0.741377,2.58176},{-2.28173,1.97764,1.8177},{-1.41018,-3.17721,0.581443},{-1.41018,-1.94095,2.58176},{-1.41018,1.94095,-2.58176},{-1.41018,3.17721,-0.581443},{-1.17576,-2.78117,-1.8177},{-1.17576,-0.382026,-3.30046},{-1.17576,0.382026,3.30046},{-1.17576,2.78117,1.8177},{-0.726656,-3.3993,-0.581443},{-0.726656,-1.00016,3.30046},{-0.726656,1.00016,-3.30046},{-0.726656,3.3993,0.581443},{-0.683527,-2.94111,1.8177},{-0.683527,2.94111,-1.8177},{0.,-2.39915,-2.58176},{0.,-1.23626,-3.30046},{0.,1.23626,3.30046},{0.,2.39915,2.58176},{0.683527,-2.94111,1.8177},{0.683527,2.94111,-1.8177},{0.726656,-3.3993,-0.581443},{0.726656,-1.00016,3.30046},{0.726656,1.00016,-3.30046},{0.726656,3.3993,0.581443},{1.17576,-2.78117,-1.8177},{1.17576,-0.382026,-3.30046},{1.17576,0.382026,3.30046},{1.17576,2.78117,1.8177},{1.41018,-3.17721,0.581443},{1.41018,-1.94095,2.58176},{1.41018,1.94095,-2.58176},{1.41018,3.17721,-0.581443},{2.28173,-1.97764,-1.8177},{2.28173,-0.741377,-2.58176},{2.28173,0.741377,2.58176},{2.28173,1.97764,1.8177},{2.58594,-2.32298,0.581443},{2.58594,-1.55893,1.8177},{2.58594,1.55893,-1.8177},{2.58594,2.32298,-0.581443},{3.00838,-1.74153,-0.581443},{3.00838,-0.258779,1.8177},{3.00838,0.258779,-1.8177},{3.00838,1.74153,0.581443},{3.45748,-0.359351,-0.581443},{3.45748,0.359351,0.581443}}
LIST ={1.37, 1.45};
tol=0.01;
Your matrix B
is correct. You can get the correct plot by changing the 2nd argument for Flatten
from 2 to 1:
Show[Graphics3D[
Line[Flatten[
Table[If[B[[i, j]] == 1, {DATAC60[[i]], DATAC60[[j]]},
Nothing], {i, 1, Length[B]}, {j, 1, Length[B]}], 1]]],
BoxRatios -> {1, 1, 1}]
I know it’s not part of your question, but I thought I’d show an easier way to make B
that might be a little easier to read through, and catch errors.
Our goal is to find the atoms in DATAC60
that are separated by a distance magnitude within tol
of an element in LIST
:
distMat = DistanceMatrix@DATAC60;
B = Map[Min@Abs[LIST - #] <= tol &, distMat, {2}] // Boole;
In the code above we calculate the distance between every vertex in DATAC60
(the default DistanceFunction
for DistanceMatrix
is EuclideanDistance
).
We then make a matrix of 1s and 0s based off if the distances are within tol
of a length in LIST
.
To check for correctness, we then plot the vertices and edges together:
posLessThanTol = Position[B, 1];
lineList = Line@Table[Part[DATAC60, #] & /@ i, {i, posLessThanTol}];
Show[Graphics3D[{Thickness[4*10^-3], Blue, lineList, Red,
PointSize[0.02], Point[DATAC60]}], BoxRatios -> {1, 1, 1}]
Edit: I though I’d also show another way to make this Graphic from the {x,y,z} data without making a matrix B
at all:
startEndDistance =
Flatten[Outer[{#1, #2, Norm[#1 - #2]} &, DATAC60, DATAC60, 1], 1];
bonds = Most /@
Select[startEndDistance, 0 < Min@Abs[#[[-1]] - LIST] <= tol &];
lineList = Line[bonds];
(*use same Show[Graphics3D... commands from above to make same plot*)
Or possibly if you don’t want/have to use the data in DATAC60
:
ChemicalData["FullereneC60", "MoleculePlot"]