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
