Search This Blog

Wednesday, August 16, 2006

A little VBA helps 3D Solids

A member of the Jacksonville AutoCAD User Group, an AUGI registered local user group, recently asked how to get meaningful information from 3D solids he was working with on a daily basis. As a structural designer of pre-cast panels, he would model his concrete panels inside AutoCAD but couldn't find an easy way to report the volume in a usable form. AutoCAD does a great job of delivering the true volume of the panels, but it does it in basic units only. This requires additional math to deliver the industry standard volume typically reported and calculated in cubic yards rather than cubic inches.

Enter VBA to the rescue! Here is the result of a few minutes of code. Of course, this code could be extended to automatically sum all solids found and even export a meaningful spreadsheet or report if needed. For the purposes of this blog entry, I will limit the code to a very simple example. Rather than use the inquiry tool button and cut and paste it into a conversion calculator, we will create a vba routine and call it from a toolbar button. Now the lucky member can simply pick a toolbar button, then pick an AutoCAD 3D solid and find out immediately the volume of the panel selected. Here is the resulting code.

Public Sub DisplayVolume()
'Declare your variables: a solid, an insertion point, a
'generic autocad object and a message variable
Dim mySolid As Acad3DSolid
Dim myInsertionPt As Variant
Dim tempObj As AcadObject
Dim myMsg As String
On Error Resume Next
RETRY: 'Label for simple error looping
'Use the built-in utility:GetEntity to select an object
ThisDrawing.Utility.GetEntity tempObj, myInsertionPt, "Select Panel"
'Check for errors and allow user to reselect
If Err <> 0 Then
'Check selection for type of object
If TypeOf tempObj Is Acad3DSolid Then
'if the right type of object is found
'assign it to correct type variable
Set mySolid = tempObj
'perform simple math and save result as string
myMsg = ((mySolid.Volume / 1728) / 27)
'display string for user
MsgBox FormatNumber(myMsg, 2) & " Cu. Yds", vbInformation, "VBA Rocks"
'wrong object type allow reselection
myMsg = "Only 3D Solids please" & vbCrLf & _
"Care to try again?"
If MsgBox(myMsg, vbYesNo, "Beside The Cursor!") = vbYes Then
'if yes then go to retry
ThisDrawing.Utility.Prompt vbCrLf & "VBA is so Cool!"
End If
End If
End If
End Sub

The code above was only a few lines of code when completed during the LUG meeting. I have since added some error trapping, notification, and additional comments to make it more user friendly and self documenting. Feel free to use this code as you see fit and extend it to be even more useful in your work environment.

Click this link to download zip file containing this macro and a menu containing the loading code and tool button to run it.