Volume of a Shape

Not sure how to upload scripts to these new forums but I had a puzzle the other day to work out the volume of an object and came across a very simple algorithm.

Select one or more shape objects (must be manifold for it to work) then run the script

Here’s the script VolumeCalc.vbs – I suspect the wrapping might cause problems…

'*********************************************************************************
' Purpose: Find Volume of manifold object
'
' Version for 3DC 8.2.2+
'
' Paul Gausden July 2012
'
'*********************************************************************************

Option Explicit 'require variable declarations

Sub Main (Scene)

Dim ActiveCount
Dim i, o,s
dim pn
Dim Vol

'get the active object count
ActiveCount = Scene.GetSelectedShapesCount()

'only proceed if there is an active object

If ActiveCount = 0 Then
MsgBox "Please select one or more objects."
Else
For I = 0 to ActiveCount-1

set o = Scene.GetSelectedShape(I)
pn=""
ParentName o.GetParentGroup(),pn
s=s & I & " " & pn & o.GetName & ": "

if Manifold(o) Then

vol=Volume(o)

s=s & Round(vol,5)
Else
s=s & "****"
End If

if i mod 8 = 7 then
msgbox s
s=""
Else
s=s & vbCr
End if

Next ' object
MsgBox s
End If
End Sub

Sub ParentName(grp,s)
if grp is Nothing Then Exit Sub
s=grp.GetName() & "/" & s
ParentName grp.GetParent(),s
End Sub

Function Volume(o)
dim f,p,ax,ay,az,bx,by,bz,ox,oy,oz,i,fo,j,det,p1

f=o.GetFaceCount()
Volume=0
for i=0 to f-1

set fo=o.GetFace(i)
' origin
p1=fo.GetPointID(0)
o.GetPointXYZ p1,ox,oy,oz
p1=fo.GetPointID(1)
o.GetPointXYZ p1,ax,ay,az

For j=2 to fo.GetPointCount()-1

p1=fo.GetPointID(j)
o.GetPointXYZ p1,bx,by,bz

' calculating determinator
det = (ox*ay*bz) - (ox*az*by) - (oy*ax*bz) + (oy*az*bx) + (oz*ax*by) - (oz*ay*bx)

Volume = Volume + det/6

' move to next triangle in the fan
ax=bx
ay=by
az=bz
Next
Next

End Function

Function Manifold(o)

Dim i, p, j,f,k,l, p1, p2, fo, OK
Dim edges()

p=o.GetPointCount()
f=o.GetFaceCount()
Redim edges(f-1,p-1)

' now find the edges
For j = 0 to f-1
set fo=o.GetFace(j)
l=fo.GetPointCount()
For k = 0 to l-1
p1=fo.GetPointID(k)
p2=fo.GetPointID((k+1) mod l)
edges(j,p1)=p2+1
Next
Next
' for each face edge, look for common face edge

Manifold=True

For j = 0 to f-1
For k=0 to p-1
OK = False
If edges(j,k)>0 then
p2=edges(j,k)-1
' look for common edge on another face
For l=0 to f-1
If l j and (edges(l,p2)-1)= k then
OK=True
Exit For
End If
Next

' no common edge
If not OK then
Manifold=False
Exit For
End If
End If
Next
' no common edge
If not OK then Exit For
Next

End Function

Paul

You must be logged in to reply in this thread.