moleculeImageSize[mol_Molecule,scale_:0.5]:= Module[{atoms,bonds,coords,dist,minmax}, atoms=mol["AtomList"]/.Atom[a_,___]:>a// AssociationThread[Range@Length@#,#]&; bonds=Select[mol["BondList"]/.Bond[ij_,___]:>ij, FreeQ[atoms/@#,"H"]&]; coords=QuantityMagnitude@mol["AtomDiagramCoordinates"]; dist=EuclideanDistance@@coords[[#]]&/@bonds// Replace[{}->{0}]//Mean; minmax=coords[[#]]&/@bonds//Catenate//Map[First]//MinMax; Max[36,Min[672,(Subtract@@Reverse@minmax)/Max[1,dist]scale72]] ]$RBNMoleculeFormat=True;Print["Set $RBNMoleculeFormat = False to restore built-in behavior."];Chemistry`Formatting`moleculeBox[mol_,fmt_]/;TrueQ[$RBNMoleculeFormat]:= If[Chemistry`Common`has3DCoordinates[mol], With[{graphics=MoleculePlot[mol]}, {plot=ToBoxes[graphics,fmt]}, Replace[plot,{HoldPattern[Graphics3DBox[x_,y___]]:> Graphics3DBox[TagBox[x,BoxForm`ChemistryTag[HoldComplete[mol]]],y, ContentSelectable->False, Selectable->False, DefaultBaseStyle->{FrontEnd`GraphicsHighlightColor-> RGBColor[0.269281,0.535948,0.63268]}], _:>$Failed} ] ], With[{graphics=MoleculePlot[mol,ImageSize->moleculeImageSize[mol,0.375]]}, {plot=ToBoxes[graphics,fmt]}, Replace[plot,{HoldPattern[GraphicsBox[x_,y___]]:> GraphicsBox[TagBox[x,BoxForm`ChemistryTag[HoldComplete[mol]]],y, ContentSelectable->False, Selectable->False, DefaultBaseStyle->{FrontEnd`GraphicsHighlightColor-> RGBColor[0.269281,0.535948,0.63268]}], _:>$Failed} ] ] ]