(vba)how to get graphic info from a comlex entity

[kenneth8848]

i am working on a essay that requires calculate the floating state of a specific ship,i had managed to loft the boat into a "autocadloftedsolid".but i need to "intersect" the boat with another box(return the part that below water line) for 100 times in oder to find

(if boat.volume*density="part that below water ".volum*density)

its water-line and calculate the mass point and floating force point .(i also need to rotate the boat for 20 times,thats 100*20=2000times:o)

 

Is there any way to return the information that we can get from the command "massprop" automaticaly or simply convert "autocadloftedsolid" into "3dsolid"since i found the ".volume" function in "3dsolid" class.Or is there a way to do it in lisp.

[kenneth8848]

i have a silly way but the speed is far from satisfaction

Sub calculus( m() As Double, v As Double, boat As Acad3DSolid, div() As Integer, dele As Boolean)

Dim pmax As Variant

Dim pmin As Variant

boat.GetBoundingBox pmin, pmax

Dim lx As Double

Dim ly As Double

Dim lz As Double

 

 

lx = (pmax(0) - pmin(0)) / div(0)

ly = (pmax(1) - pmin(1)) / div(1)

lz = (pmax(2) - pmin(2)) / div(2)

Dim p1(2) As Double

Dim cent(2) As Double

Dim mtemp(2) As Double

Dim vtemp As Double

 

Dim bt As Acad3DSolid

Dim box As Acad3DSolid

On Error Resume Next

p1(0) = pmin(0)

p1(1) = pmin(1)

p1(2) = pmin(2)

 

For kk = 1 To div(2)

For jj = 1 To div(1)

For ii = 1 To div(0)

cent(0) = p1(0) + lx / 2

cent(1) = p1(1) + ly / 2

cent(2) = p1(2) + lz / 2

Set bt = boat.Copy

Set box = ThisDrawing.ModelSpace.AddBox(cent, lx, ly, lz)

p1(0) = p1(0) + lx

 

bt.Boolean acIntersection, box

 

If Err.Number -2147418113 Then

vtemp = bt.Volume

mtemp(0) = mtemp(0) + vtemp * cent(0)

mtemp(1) = mtemp(1) + vtemp * cent(1)

mtemp(2) = mtemp(2) + vtemp * cent(2)

itemp(0) = itemp(0) + vtemp * cent(0) * cent(0)

itemp(1) = itemp(1) + vtemp * cent(1) * cent(1)

itemp(2) = itemp(2) + vtemp * cent(2) * cent(2)

If dele = True Then

bt.Delete

End If

Else

box.Delete

bt.Delete

End If

Err.Clear

Next

 

p1(0) = pmin(0)

p1(1) = p1(1) + ly

Next

p1(0) = pmin(0)

p1(1) = pmin(1)

p1(2) = p1(2) + lz

Next

i = itemp

m = mtemp

v = boat.Volume

End Sub