Option Explicit 'Script written by peter harris 'www.peterwhatcreates.com Call Main() Sub Main() Dim arrObjects, X, Y, Z, Material, DensityTest, CBtext, TextChunk, strObject Dim ObjectWeight, ObjectMaterial, Density, ObjectName, TestMaterial, arrMP, ObjectVolume Dim TextChunkForClipboard, ObjectNote Dim arrForCSV(), TextChunkForCSV Dim CurrentUnits CurrentUnits = Rhino.UnitSystem arrObjects = Rhino.GetObjects("Select objects to create BOM ", 8 + 16 + 32 + 4096,, True) If IsArray(arrObjects) Then '--------------------------------------------------------------------- ' ask which colums to inclue Dim arrColumnsPicker, arrPickerStates, arrColumnsToInclude, i arrColumnsPicker = Array("Name", "Real Material And Weights", "Box Size", "Notes", "Volume", "Surface Area", "Layer", "Volume Centroid", "Area Centroid") arrPickerStates = Array(1, 1, 1, 1, 0, 0, 0, 0, 0) arrColumnsToInclude = Rhino.CheckListBox(arrColumnsPicker, arrPickerStates, "Pick which data you want", "Columns") If Not IsNull(arrColumnsToInclude) Then '--------------------------------------------------------------------- ' check to see if need to ask about weight units '--------------------------------------------------------------------- If arrColumnsToInclude(1) = True Then 'ask weight units Dim LengthConversion Dim arrDensity(), MaterialOptions GetDensity arrDensity, MaterialOptions 'convert them all to cubic cm - multiply by this number! Select Case CurrentUnits Case 2 LengthConversion = .001 Case 3 LengthConversion = 1 Case 4 LengthConversion = 1000000 Case 8 LengthConversion = 16.387064 Case 9 LengthConversion = 28316.8444 Case Else Msgbox "This unit system is not supported - you are using system # " & CurrentUnits Exit Sub End Select 'ask what output they want Dim arrOutputWeightUnits(3), TextForOutputQ, strWeightUnits, WeightConversion, TotalConversionFactor arrOutputWeightUnits(0) = "grams" arrOutputWeightUnits(1) = "kilograms" arrOutputWeightUnits(2) = "ounces" arrOutputWeightUnits(3) = "pounds" TextForOutputQ = "Select output units" strWeightUnits = Rhino.ListBox(arrOutputWeightUnits, TextForOutputQ, "Units options") If Not IsNull(strWeightUnits) Then If strWeightUnits <> "" Then Select Case strWeightUnits Case "grams" WeightConversion = 1 Case "kilograms" WeightConversion = .001 Case "ounces" WeightConversion = 0.0352739619 Case "pounds" WeightConversion = 0.00220442262 Case Else Exit Sub End Select TotalConversionFactor = LengthConversion * WeightConversion End If End If End If '--------------------------------------------------------------------- Z = 0 CBtext = "" TextChunk = "" TextChunkForClipboard = "" Dim arrTitles, arrData, Counter For Each strObject In arrObjects ObjectWeight = "n/a" ObjectMaterial = "unknown" ObjectNote = "n/a" Density = "not in table" VolCentroid = "n/a" AreaCentroid = "n/a" ReDim arrTitles(0) ReDim arrData(0) Counter = 0 TextChunkForCSV = "" TextChunkForClipboard = "" TextChunk = "" '-------------------- ADD UNITS -------------------------------------------------- If arrColumnsToInclude(4) = True Or arrColumnsToInclude(5) = True Or arrColumnsToInclude(2) = True Then' add units Dim strUnits strUnits = "Unknown" Select Case CurrentUnits Case 0 strUnits = "No unit system" Case 1 strUnits = "Microns" Case 2 strUnits = "Millimeters" Case 3 strUnits = "Centimeters" Case 4 strUnits = "Meters" Case 5 strUnits = "Kilometers" Case 6 strUnits = "Microinches" Case 7 strUnits = "Mils" Case 8 strUnits = "Inches" Case 9 strUnits = "Feet" Case 10 strUnits = "Miles" Case 11 strUnits = "Custom" Case 12 strUnits = "Angstroms" Case 13 strUnits = "Nanometers" Case 14 strUnits = "Decimeters" Case 15 strUnits = "Dekameters" Case 16 strUnits = "Hectometers" Case 17 strUnits = "Megameters" Case 18 strUnits = "Gigameters" Case 19 strUnits = "Yards" Case 22 strUnits = "Nautical mile" Case 23 strUnits = "Astronomical" Case 24 strUnits = "Lightyears" Case 25 strUnits = "Parsecs" End Select End If '-------------------- NAME -------------------------------------------------- If arrColumnsToInclude(0) = True Then 'name ObjectName = Rhino.ObjectName(strObject) If IsNull(ObjectName) Then ObjectName = "unnamed" End If AddToArrays ObjectName, "Name", Counter, arrTitles, arrData End If '-------------------- MATERIAL AND WEIGHT -------------------------------------------------- If arrColumnsToInclude(1) = True Then'real material and weight ObjectMaterial = Rhino.GetObjectData(strObject, "ObjectProperties", "Material") If IsNull(ObjectMaterial) Then ObjectMaterial = "unknown" ObjectWeight = "n/a" Else Y = 0 For Each TestMaterial In MaterialOptions If ObjectMaterial = TestMaterial Then Density = arrDensity(Y) End If Y = Y + 1 Next arrMP = Rhino.SurfaceVolume(strObject) If IsArray(arrMP) Then ObjectVolume = CStr(arrMP(0)) If IsNull(ObjectVolume) Then ObjectWeight = "n/a" Else If Density = "not in table" Then ObjectWeight = "n/a" Else ObjectWeight = ROUND((ObjectVolume * Density * TotalConversionFactor), 5) End If End If End If End If AddToArrays ObjectMaterial, "Material", Counter, arrTitles, arrData AddToArrays ObjectWeight, "Weight " & CHR(40) & strWeightUnits & CHR(41), Counter, arrTitles, arrData End If '-------------------- SIZE -------------------------------------------------- If arrColumnsToInclude(2) = True Then 'get size Dim BoundBox, ObjectSize BoundBox = Rhino.BoundingBox(strObject) Dim dimX : dimX = rhino.Distance(BoundBox(0), BoundBox(1)) Dim dimY : dimY = rhino.Distance(BoundBox(0), BoundBox(3)) Dim dimZ : dimZ = rhino.Distance(BoundBox(0), BoundBox(4)) ObjectSize = ROUND((dimX), 3) & ", " & ROUND((dimY), 3) & ", " & ROUND((dimZ), 3) AddToArrays ObjectSize, "Size " & CHR(40) & strUnits & CHR(41), Counter, arrTitles, arrData End If '-------------------- NOTES -------------------------------------------------- If arrColumnsToInclude(3) = True Then 'object note ObjectNote = Rhino.GetObjectData(strObject, "ObjectProperties", "ObjectNote") If IsNull(ObjectNote) Then ObjectNote = "n/a" End If AddToArrays ObjectNote, "Note", Counter, arrTitles, arrData End If '-------------------- VOLUME -------------------------------------------------- If arrColumnsToInclude(4) = True Then' volume Dim arrVolume, strVolume arrVolume = Rhino.SurfaceVolume(strObject) If IsArray(arrVolume) Then strVolume = CStr(arrVolume(0)) If IsNull(strVolume) Then strVolume = "n/a" Else strVolume = ROUND(strVolume, 5) End If End If AddToArrays strVolume, "Volume " & CHR(40) & "cu " & strUnits & CHR(41), Counter, arrTitles, arrData End If '-------------------- SURFACE AREA -------------------------------------------------- If arrColumnsToInclude(5) = True Then' surface area Dim arrSurfArea, strSurfArea arrSurfArea = Rhino.SurfaceArea(strObject) If IsArray(arrSurfArea) Then strSurfArea = CStr(arrSurfArea(0)) If IsNull(strSurfArea) Then strSurfArea = "n/a" Else strSurfArea = ROUND(strSurfArea, 5) End If End If AddToArrays strSurfArea, "Surface Area " & CHR(40) & "sq " & strUnits & CHR(41), Counter, arrTitles, arrData End If '-------------------- LAYER -------------------------------------------------- If arrColumnsToInclude(6) = True Then' layer Dim strLayer strLayer = Rhino.ObjectLayer(strObject) AddToArrays strLayer, "Layer", Counter, arrTitles, arrData End If '-------------------------VOLUME CENTROID -------------------------------------------------- If arrColumnsToInclude(7) = True Then Dim arrVC, VolCentroid If Rhino.IsPolySurfaceClosed(strObject) Then arrVC = Rhino.SurfaceVolumeCentroid(strObject) If IsArray(arrVC) Then VolCentroid = Rhino.Pt2Str(arrVC(0), 4) End If End If AddToArrays VolCentroid, "Volume Centroid", Counter, arrTitles, arrData End If '------------------------ AREA CENTROID -------------------------------------------------- If arrColumnsToInclude(8) = True Then Dim arrAC, AreaCentroid If Rhino.IsPolySurfaceClosed(strObject) Then arrAC = Rhino.SurfaceAreaCentroid(strObject) If IsArray(arrAC) Then AreaCentroid = Rhino.Pt2Str(arrAC(0), 4) End If End If AddToArrays AreaCentroid, "Area Centroid", Counter, arrTitles, arrData End If Dim strY, strX, ChunkLen ReDim Preserve arrForCSV(Z+2) If Z = 0 Then 'create title row For Each strY In arrTitles TextChunkForClipboard = TextChunkForClipboard & strY & CHR(9) TextChunkForCSV = TextChunkForCSV & CHR(34) & strY & CHR(34) & CHR(44) Next CBtext = CBtext & vbCrLf & TextChunkForClipboard ChunkLen = Len(TextChunkForCSV) TextChunkForCSV = (Left(TextChunkForCSV, ChunkLen - 1)) arrForCSV(0) = CHR(13) arrForCSV(1) = TextChunkForCSV TextChunkForCSV = "" TextChunkForClipboard = "" End If For Each strX In arrData TextChunkForClipboard = TextChunkForClipboard & strX & CHR(9) TextChunkForCSV = TextChunkForCSV & CHR(34) & strX & CHR(34) & CHR(44) Next CBtext = CBtext & vbCrLf & TextChunkForClipboard ChunkLen = Len(TextChunkForCSV) TextChunkForCSV = (Left(TextChunkForCSV, ChunkLen - 1)) arrForCSV(Z + 2) = TextChunkForCSV Dim LengthOfArrays LengthOfArrays = Ubound(arrData) Dim ZCount ZCount = 0 For Each strX In arrData TextChunk = TextChunk & arrTitles(ZCount) & ": " & strX & CHR(9) & CHR(9) ZCount = ZCount + 1 Next Rhino.Print TextChunk Z = Z + 1 Next Rhino.ClipboardText CBtext ' 'ask about output To csv Dim WriteItToCSV, strCsvFile WriteItToCSV = Rhino.MessageBox("Data has been copied to the clipboard. Create .csv file, too?", 4, "write to csv") If WriteItToCSV = 6 Then Rhino.Print "Please wait - generating data" strCsvFile = Rhino.SaveFileName("Save", "Text Files (*.csv)|*.csv||") If Not IsNull(strCsvFile) Then Call Rhino.WriteTextFile(strCsvFile, arrForCSV) End If End If Else Rhino.Print "nothing selected" End If End If End Sub Sub AddToArrays(DataBit, TitleBit, Counter, arrTitles, arrData) ReDim Preserve arrTitles(Counter) ReDim Preserve arrData(Counter) arrTitles(Counter) = TitleBit arrData(Counter) = DataBit Counter = Counter + 1 End Sub Sub GetDensity(arrDensity, MaterialOptions) 'check if file exists - if not, create it Dim DefaultText DefaultText = "How To Edit The Materials List:" & _ vbCrLf & "To edit the list, just add your materials, Then an equal sign, and the specific gravity of your material." & _ vbCrLf & "Do Not begin a material name With a number Or other characters - just letters." & _ vbCrLf & "Do Not put In multiple materials that have the same name, and Do Not put spaces In the material names" & _ vbCrLf & "Leave the EditMaterialsList=EditMaterialsList line intact. You can re-arrange the order as much as you would like." & _ vbCrLf & "To add materials for which you do not know the specific gravity, convert them to grams per cubic cm." & _ vbCrLf & "To convert from whatever units you know, go to google and type in something like:" & _ vbCrLf & CHR(34) & "40 pounds per cubic foot in grams per cubic cm" & CHR(34) & " ...and google will return the number to enter here." & _ vbCrLf & "You can also move materials from the MaterialsToHide list to the MaterialsList list and vise-versa," & _ vbCrLf & "which can keep your options simple and customized for you without getting rid of materials that you might need someday." & _ vbCrLf & vbCrLf & "Here is one website that lists specific gravities of various materials:" & _ vbCrLf & "http://www.reade.com/Particle_Briefings/spec_gra.html" & _ vbCrLf & vbCrLf & vbCrLf & "[MaterialsList]" & _ vbCrLf & "ppr=0.900100225" & _ vbCrLf & "abs=1.05082887" & _ vbCrLf & "his=1.03740365" & _ vbCrLf & "eva=0.945868033" & _ vbCrLf & "lpe=0.945868033" & _ vbCrLf & "mis=1.03740365" & _ vbCrLf & "nyl=1.11063214" & _ vbCrLf & "pvc=1.28149863" & _ vbCrLf & "EditMaterialsList=EditMaterialsList" & _ vbCrLf & vbCrLf & vbCrLf & "[MaterialsToHide]" & _ vbCrLf & "water=1" & _ vbCrLf & "Renshape_BM5440=0.55" & _ vbCrLf & "Renshape_BM70=0.7" & _ vbCrLf & "Renshape_450=0.65" & _ vbCrLf & "Renshape_440=0.77" & _ vbCrLf & "Axson_ProLab_65=0.65" & _ vbCrLf & "Gold=19.32" & _ vbCrLf & "Silver=10.5" & _ vbCrLf & "Platinum=21.45" Set objFso = CreateObject("Scripting.FileSystemObject") Dim FileLocation : FileLocation = objFso.GetSpecialFolder(2) + "MaterialSpecificGravityList.ini" If Not objFso.FileExists(FileLocation) Then objFso.CreateTextFile(FileLocation) Set objFso = Nothing Dim objFSO, objFile Set objFSO = CreateObject("Scripting.FileSystemObject") If (objFSO.FileExists(FileLocation)) Then Set objFile = objFSO.OpenTextFile(FileLocation, 8, True, -2) Call objFile.Write(DefaultText) Call objFile.Close() Set objFile = Nothing Set objFSO = Nothing End If End If Set objFso = Nothing ' done -------------------------------- Dim X, Material,DensityTest MaterialOptions = Rhino.GetSettings(FileLocation, "MaterialsList") If IsArray(MaterialOptions) Then X = 0 For Each Material In MaterialOptions ReDim Preserve arrDensity(X) arrDensity(X) = Rhino.GetSettings(FileLocation, "MaterialsList", Material) DensityTest = EVAL(arrDensity(X)) If DensityTest <= 0 Then arrDensity(X) = 0 X = X + 1 Next Else Exit Sub End If End Sub