# 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.

Not Support
1 post