TheSwamp
Code Red => VB(A) => Topic started by: Bryco on May 26, 2007, 06:49:28 PM

Here is a way to draw a line through the centers of a cylinder.
It uses a rather simple sub DrawCylinderCenterlineLine and a couple of functions that do a bit of math.
PrincipalDirections is the key, it comprises the x,y,z vectors for the solid. The z vector is the normal and gives the extrusion direction. (The help for this item is a bit how's your father.) As you probably already know, 3dsolids don't have much info availible in cad vba, the PrincipalDirections combined with the BoundingBox gives us a little more. The boundingbox is not that useful until you transform the object, then you know the z difference will be the objects height.
Option Explicit
'Bryco Swamp code 52607
Sub DrawCylinderCenterlineLine(oCylinder As Acad3DSolid)
Dim Xaxis(2) As Double, Yaxis(2) As Double, Zaxis(2) As Double
Dim Pd As Variant
Dim i As Integer
Dim min As Variant, max As Variant
Dim oUcs As AcadUCS
Dim m As Variant
Dim oLine As AcadLine
Dim StartPt As Variant, EndPt As Variant
Dim Ht As Double
Dim Zero(2) As Double
'Debug.Print vbAssoc(oCylinder, 1)
Pd = oCylinder.PrincipalDirections
For i = 0 To 2
Xaxis(i) = Pd(i)
Yaxis(i) = Pd(i + 3)
Zaxis(i) = Pd(i + 6)
Next i
Set oUcs = ThisDrawing.UserCoordinateSystems.Add(Zero, Xaxis, Yaxis, "3d")
oUcs.Origin = oCylinder.Centroid
m = oUcs.GetUCSMatrix
oCylinder.TransformBy (InverseMatrix(m))
oCylinder.GetBoundingBox min, max
Ht = (max(2)  min(2)) / 2
StartPt = Zero
StartPt(2) = StartPt(2)  Ht
EndPt = Zero
EndPt(2) = EndPt(2) + Ht
Set oLine = ThisDrawing.ModelSpace.AddLine(StartPt, EndPt)
oLine.TransformBy m
oCylinder.TransformBy m
End Sub
Sub Test()
Dim Ent As AcadEntity, V, C As Acad3DSolid
ThisDrawing.Utility.GetEntity Ent, V, "Pick"
If TypeOf Ent Is Acad3DSolid Then
Set C = Ent
DrawCylinderCenterlineLine C
End If
End Sub
Function Rd(num1 As Variant, num2 As Variant) As Boolean
Dim dRet As Double
dRet = num1  num2
If Abs(dRet) < 0.00000001 Then Rd = True
End Function
Function InverseMatrix(m As Variant) As Variant
Dim Matrix() As Double
Dim RowCt As Integer, ColCt As Integer
Dim NewColCt As Integer
Dim NoInverse As Boolean
Dim i As Integer, J As Integer
RowCt = UBound(m, 1)
ColCt = UBound(m, 2)
NewColCt = ColCt + RowCt + 1
ReDim Matrix(RowCt, NewColCt)
For i = 0 To RowCt
'add the given matrix
For J = 0 To ColCt
If Rd(m(i, J), 0) Then
Matrix(J, i) = 0
Else
Matrix(J, i) = m(i, J)
End If
Next J
'add an identity crisis
For J = ColCt + 1 To NewColCt
If J  (ColCt + 1) = i Then
Matrix(i, J) = 1
Else
Matrix(i, J) = 0
End If
Next
Next i
Matrix = MPivot(Matrix)
'now see if it worked
For i = 0 To RowCt
For J = 0 To ColCt
If J = i Then
If Not Rd(Matrix(i, J), 1) Then
NoInverse = True
End If
Else
If Not Rd(Matrix(i, J), 0) Then
NoInverse = True
'Exit Function
End If
End If
Next
Next i
If NoInverse Then
Matrix = OrderMatrix(Matrix)
End If
'If Not NoInverse Then
ReDim InVMatrix(RowCt, ColCt)
For i = 0 To RowCt
For J = ColCt + 1 To NewColCt
InVMatrix(i, J  (ColCt + 1)) = Matrix(i, J)
Next J
Next i
'End If
InverseMatrix = Transpose(InVMatrix)
End Function
Function MPivot(Matrix) As Variant
Dim J As Integer, i As Integer, k As Integer
Dim iP As Integer
Dim pivot As Double
Dim ColCt As Integer
Dim RowCt As Integer
Dim PC As Double
Dim Sign As Integer
Dim Den As Integer
Dim dTemp As Double
RowCt = UBound(Matrix, 1)
ColCt = UBound(Matrix, 2)
'ij is row,column
'Pivot is first non zero item in row
For i = 0 To RowCt
For J = 0 To ColCt
If Matrix(i, J) <> 0 Then
pivot = Matrix(i, J)
iP = J
Exit For
End If
Next J
For k = 0 To RowCt
If Not k = i Then
PC = Matrix(k, iP)
If PC = 0 Then GoTo skip
Sign = 1
If pivot < 0 Then
If PC < 0 Then
Sign = 1
End If
Else
If PC > 0 Then
Sign = 1
End If
End If
Dim n1 As Double, n2 As Double
n1 = Abs(pivot): n2 = Abs(PC)
Den = LCD(n1, n2)
For J = 0 To ColCt
dTemp = Matrix(k, J) * n1 / Den + (Matrix(i, J) * n2 / Den * Sign)
If Rd(dTemp, 0) Then
Matrix(k, J) = 0
Else
Matrix(k, J) = dTemp
End If
Next J
End If
skip:
Next k
Next i
For i = 0 To RowCt
For J = 0 To ColCt
If Matrix(i, J) <> 0 Then
pivot = 1 / Matrix(i, J)
Exit For
End If
Next J
For J = 0 To ColCt
Matrix(i, J) = Matrix(i, J) * pivot
Next J
Next i
MPivot = Matrix
End Function
Function OrderMatrix(Matrix As Variant) As Variant
Dim i As Integer, J As Integer
Dim k As Integer, l As Integer
Dim RowCt As Integer, ColCt As Integer
RowCt = UBound(Matrix, 1)
ColCt = UBound(Matrix, 2)
ReDim tempRow(ColCt) As Double
'ij is row,column
For i = 0 To RowCt
For J = 0 To ColCt
If J = i Then
If Not Rd(Matrix(i, J), 1) Then
For k = 0 To RowCt
If Not k = i Then
If Rd(Matrix(k, J), 1) Then
For l = 0 To ColCt
tempRow(l) = Matrix(k, l)
Matrix(k, l) = Matrix(i, l)
Matrix(i, l) = tempRow(l)
Next l
End If
End If
Next k
End If
End If
Next J
Next i
OrderMatrix = Matrix
End Function
Function Transpose(Matrix As Variant) As Variant
Dim iCnt As Integer, jCnt As Integer
Dim transMat(0 To 3, 0 To 3) As Double
Dim i As Integer, J As Integer
iCnt = UBound(Matrix, 1)
jCnt = UBound(Matrix, 2)
For i = 0 To iCnt
For J = 0 To jCnt
transMat(i, J) = Matrix(J, i)
Next J
Next i
Transpose = transMat
End Function
Function LCD(n1, n2) As Integer
'LowestCommonDenominator
Dim iCt As Integer, i As Integer
Dim Ans As Integer
Ans = 1
If n1 < n2 Then
iCt = n1
Else
iCt = n2
End If
If iCt > 1 Then
For i = 1 To iCt
If (n1 Mod i = 0 And n2 Mod i = 0) Then Ans = i
Next i
End If
LCD = Ans
End Function
For further examination is the dxf code info mogoo mi m o
is a print out SomeCallMeDave's function vbassoc (It's on this site). The mi seems to imply an oval (ie an ellipse,circle or polycircle), whereas
mogoo gi m o seems to imply a box. It may be possible to make a class of primitive solids using a combo of this info and the relationship of the length of the line to the volume property.

I had investigated the use of principal direction but experienced inconsistant results. I have to say your routine is considerably better behaved than my attempts, but it does experience problems with cylinders created in "odd" UCS's (at least on my setup). With the attached file, how is the line drawn for you?
The cylinder was created with the "UCSDuringCyl" ucs active.

After looking at the issue more closly, it shouldn't be to troublesome to confirm which of the vectors is the longest  and proceed accordingly.
Thanks for this key. It will allow the completion of some BOM coding that has been languishing. :)

Very nice approach from VB. Thank you for sharing that code. It is very impressive. I sure am going to study it to learn more about working with the matrix.
I am currently using an ARX to return the boundingbox, regardless of orientation and symmetry. Once i have that I am about done. All of these idea that you, Mick, and a few others have are quite interesting. They certainly have values in different ways. I find it difficult to see anything clearly enough, my lacking understanding of your code and Mick's, to see something I really need or want and how to deploy that in my original code. I am actually past this issue for the most part. Sure, there are ways to improve what I have done, but what I have now works pretty damn well. I am reluctant to butcher existing code, with all the consequences of existing users, without seeing a clear benefit and the area to make the changes. Your post certainly will teach me more about the matrix issue and I am hopeful that I will be able to deploy a faster routine, free of assumptions, in the near future. Thanks.
My problems are ramping up a business with typical business issues being the problem. We can build it cheaper because the technology we have deployed works. But do we expand on that to realize more profit or do we go in a direction to sell the technology to someone else? None of this has to do with VB. My brain is just too full.

Dave it's difficult to know where or how often software is useful.
The same software may not work in another similar situation just because the company is structured a different way.
As far as using this code, Seant brought up a good point that I'm still looking at, it needs a bit of work.
Matricies I learn't about them on line, they take a while to get the hang of but they are worth it. It took me a while to convert bits and pieces of C code etc to vba, but now it's just as easy to use a matrix as the translation formulae.

I do not work with 3D objects, but remember that it was available an ACIS decoder, that can be easy to use, for example to extract the length of the drawing sample in one of the post, with the decoder, you get:
(1
.
"point $1 1 $1 0.12339188410543844 13.483662729987277 2.1108923494255785 #")
(1
.
"point $1 1 $1 7.1497064366704759 5.9112661254151755 10.010938185200944 #")
Then, just by making a reader you extract the right values for the two points:
(setq p1 '(0.12339188410543844 13.483662729987277 2.1108923494255785))
(setq p2 '(7.1497064366704759 5.9112661254151755 10.010938185200944))
(distance p1 p2) = 24.0

I remember playing with principal directions some time ago when Rob Kish and I were working on this problem. We couldn't get consistent results and I think if you make some modifications, such as a slice on an angle to one end it didn't quite work as expected.
There are other properties of a solid too that can be used but again, any modifications affect the results so it just wasn't working. The problem is that acis solids need to be general enough to handle any type of modeling and this extra information may be a hindrance to other types of applications.
My take back then was not the best solution but was the easiest in the end, I had to store the data on the solid. For that I just store 'world' points as my axis vectors (as a vector and a point are basically the same thing) in xdata that are updated and copied etc. An 'entity' has an update xdata method used whenever an object is moved, rotated and such so it was the best solution for what we were doing and it was reliable.
The points can be added at creation time or later by picking 3 points on a face or setting the ucs and taking those values, I'd store the points as x = (1.0,0.0,0.0) and so on.
To use it I would extract the points, build a matrix using them and transform the solid to wcs, get the bbox values and rotate it back all behind the scenes so the user doesn't see a thing. As I was only interested in the length (z axis in this case) I'd just use the maxmin bbox z value as I already new the width and height from my catalog.
Dave has some interesting ways to do this without picking points but somewhere the end user 'may' need to assign or choose which axis is which. The method above is a set and forget version that may be a bit more elegant with a catalog type system (steel sections for instance) whereas Dave's is a bit more complicated but has a bit more freedom in that he can pick any type of solid and extract the data and it is more suited to the type of work his users are doing.
A great bonus with Dave's is he can also use legacy solids whereas I have to add the data to each solid if I wanted to use the above approach, while not that hard to do really it could be tedious on a model with lots of solids in lots of directions.
Both methods though benefit greatly from using vectors and matrices to get the solid to wcs to get the correct bbox. I'm not sure what's available in vba but the arx (therefore now also .net) geometry library is very good and has more than you would ever need for this kind of stuff, here's a listing in this thread by Kerry Brown >http://www.theswamp.org/index.php?topic=16745.0

Mick it does seem like a losing battle, sure is interesting though. I was on a role until I found that the gi in moogoo doesn't mean a box but does mean any 4 sided object extruded.It seems that the PrincipalDirections start at the centroid and slice the object in half from that point. This makes sense of the dopey angles you sometimes get.
Luis, thanks but I don't think I'll take it that far.
I use solids,but not that often.
Here is an update for anyone interested.
'Bryco Swamp code 52807
Const pi As Double = 3.14159265358979
Sub DrawCylinderCenterlineLine(oCylinder As Acad3DSolid)
Dim Xaxis(2) As Double, Yaxis(2) As Double, Zaxis(2) As Double
Dim Zero(2) As Double
Dim Pd As Variant
Dim i As Integer
Dim min As Variant, max As Variant
Dim oUcs As AcadUCS
Dim m As Variant
Dim oLine As AcadLine
Dim StartPt As Variant, EndPt As Variant
Dim Width As Double, Depth As Double, Height As Double
Dim dp As Double, Rad As Double, Vol As Double
Dim sType As String
Dim sMessage As String
Dim sName As String
sName = vbAssoc(oCylinder, 1)
Debug.Print sName
sName = Mid(sName, 7, 2)
Debug.Print sName
Pd = oCylinder.PrincipalDirections
For i = 0 To 2
Xaxis(i) = Pd(i)
Yaxis(i) = Pd(i + 3)
Zaxis(i) = Pd(i + 6)
Next i
retry:
Set oUcs = ThisDrawing.UserCoordinateSystems.Add(Zero, Xaxis, Yaxis, "3d")
oUcs.Origin = oCylinder.Centroid
m = oUcs.GetUCSMatrix
oCylinder.TransformBy (InverseMatrix(m))
oCylinder.GetBoundingBox min, max
StartPt = Zero
EndPt = Zero
Depth = (max(2)  min(2))
dp = Depth / 2
StartPt(2) = StartPt(2)  dp
EndPt(2) = EndPt(2) + dp
Select Case sName
Case "gi"
sType = "Box"
Width = max(0)  min(0)
Height = max(1)  min(1)
'Vol = Width * Height * Depth
Vol = oCylinder.Volume
sMessage = "Type: box." & vbCrLf & "Width=" & Width _
& vbCrLf & "Height=" & Height & vbCrLf & "Depth=" & Depth _
& vbCrLf & "Volume=" & Vol
Case "kg"
sType = "extruded pline"
MsgBox "Type: extruded pline"
Case "kg"
sType = "non primitive"
sMessage = "This is not a primitive solid"
GoTo NonPrimitive
Case "i "
sType = "Sphere"
Rad = (max(0)  min(0)) / 2
Vol = pi * Rad * Rad * Rad * 4 / 3
sMessage = "Type: Sphere " & vbCrLf & "Rad=" & Rad & vbCrLf & "Volume=" & Vol
Case "mi" 'Ovaloids
Width = (max(0)  min(0)) / 2
Height = (max(1)  min(1)) / 2
If Abs(Width  Height) > 0.00000001 Then
'Here we are asking if height=width then it is a cylinder
'else it is an ellipse, with the extra check for
'messed up PrincipalDirections, if the height=depth.
If Abs(Width  dp) < 0.00000001 Or Abs(Height  dp) < 0.00000001 Then
Yaxis(0) = Zaxis(0): Yaxis(1) = Zaxis(1): Yaxis(2) = Zaxis(2)
oCylinder.TransformBy m
GoTo retry
End If
sType = "Ellipsoid"
Vol = pi * Width * Height * Depth
If Width < Height Then
Width = Height
Height = (max(0)  min(0)) / 2
End If
sMessage = "Type Ellipsoid " & vbCrLf & "Major radius=" & Width _
& vbCrLf & "Minor radius=" & Height _
& vbCrLf & "Depth=" & Depth & vbCrLf & "Volume=" & Vol
Else
sMessage = "Type Cylinder/ ovaloid"
Rad = Width
Vol = pi * (Rad * Rad) * dp * 2
sMessage = "Type Cylinder " & vbCrLf & "Radius=" & Width _
& vbCrLf & "Depth=" & Depth & vbCrLf & "Volume=" & Vol
End If
Case "mn"
sType = "Cone"
MsgBox "Type Cone"
dp = (max(2)  min(2)) / 4
StartPt(2) = StartPt(2)  dp
EndPt(2) = EndPt(2) + 3 * dp
sMessage = "Type Cone " & vbCrLf & "Radius=" & Width _
& vbCrLf & "Depth=" & Depth & vbCrLf & "Volume=" & Vol
Case "ln" 'Spherical segment
' sMessage = "Spherical Cap w/ non radial slice"
' GoTo NonPrimitiveCase "ni", "nf", "ln"
Vol = oCylinder.Volume
Case "ni", "nf" 'Partial sphere
'See Mathworld http://140.177.205.23/SphericalCap.html
sType = "Spherical Cap"
Width = (max(0)  min(0)) / 2
Height = (max(1)  min(1)) / 2
If Abs(Width  Height) > 0.00000001 Then
If Abs(Width  dp) < 0.00000001 Then
Yaxis(0) = Zaxis(0): Yaxis(1) = Zaxis(1): Yaxis(2) = Zaxis(2)
oCylinder.TransformBy m
GoTo retry
End If
End If
If Abs(Depth  Width) < 0.00000001 Then sType = "Hemisphere"
Dim baseRad As Double
If Depth > Width Then
'Cap is larger than a hemisphere so the width is the sphere's radius.
Rad = Width
baseRad = Sqr(Depth * (2 * Rad  Depth))
'Debug.Print "baseRad", baseRad, Depth, Rad
Else
baseRad = Width
Rad = ((baseRad * baseRad) + (Depth * Depth)) / (2 * Depth)
End If
Vol = (pi / 6) * ((3 * baseRad * baseRad) + (Depth * Depth)) * Depth
sMessage = "Type " & sType & vbCrLf & "Sphere's radius=" & Rad _
& vbCrLf & "Base radius=" & baseRad _
& vbCrLf & "Depth=" & Depth & vbCrLf & "Volume=" & Vol
dp = 3 * (2 * Rad  Depth) * ((2 * Rad)  Depth) / (4 * ((3 * Rad)  Depth))
StartPt(2) = (Rad  Depth)  dp
EndPt(2) = Rad  dp
Case Else
GoTo NonPrimitive
End Select
If Abs(Vol  oCylinder.Volume) > 0.00000001 Then
Yaxis(0) = Zaxis(0): Yaxis(1) = Zaxis(1): Yaxis(2) = Zaxis(2)
oCylinder.TransformBy m
GoTo retry
End If
NonPrimitive:
MsgBox sMessage
Set oLine = ThisDrawing.ModelSpace.AddLine(StartPt, EndPt)
oLine.TransformBy m
oCylinder.TransformBy m
End Sub
'SomeCallMeDave
'http://www.vbdesign.net/expresso/showthread.php?postid=83887#post83887
'Changed pAcadObj As AcadObject to pAcadObj As Object to access imagedef as well
'Modified by Jeff Mishler, March 2006, to get the Block table object, not Block_Record table object
Public Function vbAssoc(pAcadObj, pDXFCode As Integer) As Variant
Dim VLisp As Object
Dim VLispFunc As Object
Dim varRetVal As Variant
Dim obj1 As Object
Dim obj2 As Object
Dim strHnd As String
Dim strVer As String
Dim lngCount As Long
Dim i As Long
Dim J As Long
On Error GoTo vbAssocError
Set VLisp = ThisDrawing.Application.GetInterfaceObject("VL.Application.16")
'Check your version ("VL.Application.1")
Set VLispFunc = VLisp.ActiveDocument.Functions
If Not TypeOf pAcadObj Is AcadBlock Then
strHnd = pAcadObj.Handle
Else
Dim lispStr As String
lispStr = "(cdr (assoc 5 (entget (tblobjname " & Chr(34) & "Block" & Chr(34) & Chr(34) & pAcadObj.Name & Chr(34) & "))))"
Set obj1 = VLispFunc.Item("read").Funcall(lispStr)
strHnd = VLispFunc.Item("eval").Funcall(obj1)
End If
Set obj1 = VLispFunc.Item("read").Funcall("pDXF")
varRetVal = VLispFunc.Item("set").Funcall(obj1, pDXFCode)
Set obj1 = VLispFunc.Item("read").Funcall("pHandle")
varRetVal = VLispFunc.Item("set").Funcall(obj1, strHnd)
Set obj1 = VLispFunc.Item("read").Funcall("(vlprinctostring (cdr (assoc pDXF (entget (handent pHandle)))))")
varRetVal = VLispFunc.Item("eval").Funcall(obj1)
vbAssoc = varRetVal
'clean up the newly created LISP symbols
Set obj1 = VLispFunc.Item("read").Funcall("(setq pDXF nil)")
varRetVal = VLispFunc.Item("eval").Funcall(obj1)
Set obj1 = VLispFunc.Item("read").Funcall("(setq pHandle nil)")
varRetVal = VLispFunc.Item("eval").Funcall(obj1)
'release the objects or Autocad gets squirrely (no offense RR)
Set obj2 = Nothing
Set obj1 = Nothing
Set VLispFunc = Nothing
Set VLisp = Nothing
Exit Function
vbAssocError:
Set obj2 = Nothing
Set obj1 = Nothing
Set VLispFunc = Nothing
Set VLisp = Nothing
MsgBox "Error occurred " & Err.Description
End Function

With the exception of Mick creating the basic equivalent of a 3D OCS with the profile, both the ACSI and parasolids modeling engines have a round off error when the object is both nonsymmetrical and and not aligned to the WCS. You cannot count on anything that ACAD calculates for at that point. All the values returned for centroid and principal direction are based on the volume of the solid and this number is wrong. The bigger the object, the bigger the error. If you take a 2 x 4, 1 1/2" x 3 1/2" x 48" and cut of one end on a 45 degree angle, the 2 x 4 is still 48" long, but ACAD thinks it is 3 5/8" wide when in fact it is only 3 1/2" wide. It cost me $175,000.00 to circumvent that error! Yes, I was ripped off blind by programmers, and it should have been less than $20,000.00. It was quite a big deal. I am still paying for it until this day.
Where I am interested in your guy's code is redundancy. My solution works really well except for 2 area's. The first has to do with getting the correct 3 dims when the object is really complicated and not aligned to the WCS. My measuring routine will sometimes provide the wrong numbers. They stick out like a sore thumb. I was able to get them all the time, but between traversing every face of every 3D solid first and the length of the routine, it was not fast enough. We loosened it up for speed, but some of these objects bleed through. The other issue is that my routine compares the length's of the sides to each other in a bigger than / less than statement. When an object has equally sized sides, either 2 or 3, my endcommand event cannot update the orientation tag automatically if any of the sides that are equal to another side is changed. I do have some handling for this, as the orientation letters are removed and you are warned on export, or you can always make sure your objects sides are slightly different. Even then, I have spent so long on this that the idea of adding a redundancy check to plug my last hole is like a fine polish. Not sure how though. As it is, I only read in what is there. I only write back 3 letters as an orientation tag to parse the 3 values returned. To add a redundancy using Mick's code, I will need to create a database of profiles and a routine to write this to the objects xdata code. Doing all of this may slow things down too much. It is an expensive test to take on just to have time test.
Thanks for the updated code. I am looking forward to checking it out. It looks like you did an awesome job!

Is there a chance to upload a sample drawing with some basic (for now and if it is possible) 3D objects, I am playing with an ACIS decoder in C++/ARX.
Thanks!

Mess with this one Luis as it's doing all the wrong things for me, there's an interesting vector comes up in massprop that I'm going to chase down now.

Mess with this one Luis as it's doing all the wrong things for me, there's an interesting vector comes up in massprop that I'm going to chase down now.
Thanks;
I am studying this:
The data was extracted from the solid that reads: 'One of the shapes moved to 0,0,0'
((1 . <Entity name: 7efada38>)
(0 . "3DSOLID")
(5 . "437")
(102 . "{ACAD_REACTORS")
(330 . <Entity name: 7efadb18>)
(102 . "}")
(330 . <Entity name: 7efabd08>)
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbModelerGeometry")
(70 . 1)
(1 . "21200 86 2 26 ")
(1
.
"16 \001utodesk \001uto\003\001\004 18 \001\023\r 12.0.0.5822 \016\024 0 ")
(1 . "25.399999999999999 9.9999999999999995e007 1e010 ")
(1 . "asmheader $1 1 12 212.0.0.5822 #")
(1 . "body $1 1 $1 $2 $1 $1 #")
(1 . "lump $1 1 $1 $1 $3 $1 #")
(1 . "shell $1 1 $1 $1 $1 $4 $1 $2 #")
(1 . "face $1 1 $1 $5 $6 $3 $1 $7 forward single #")
(1 . "face $1 1 $1 $8 $9 $3 $1 $10 forward single #")
(1 . "loop $1 1 $1 $1 $11 $4 #")
(1
.
"planesurface $1 1 $1 2.2615956455805204 2.0000000000000071 1.4670574046023415 0.79797426736327182 1.5700924586837914e016 0.60269152028716111 3.0661196849527505e017 1 2.1991747903263115e016 forward\037v I I I I #")
(1 . "face $1 1 $1 $12 $13 $3 $1 $14 forward single #")
(1 . "loop $1 1 $1 $1 $15 $5 #")
(1
.
"planesurface $1 1 $1 0.94194586084974929 2.0000000000000071 5.7086032045888881 0.99042027662361654 3.6622761598738537e032 0.13808575470626536 3.0661196849527505e017 1 2.1991747903263115e016 forward\037v I I I I #")
(1 . "coedge $1 1 $1 $16 $17 $18 $19 forward $6 $1 #")
(1 . "face $1 1 $1 $20 $21 $3 $1 $22 forward single #")
(1 . "loop $1 1 $1 $1 $23 $8 #")
(1
.
"planesurface $1 1 $1 2.229801969695103 2.0000000000000071 3.5285466106639802 0.13808575470626536 2.2204460492503136e016 0.99042027662361654 3.0661196849527505e017 1 2.1991747903263115e016 forward\037v I I I I #")
(1 . "coedge $1 1 $1 $24 $25 $26 $27 forward $9 $1 #")
(1 . "coedge $1 1 $1 $28 $11 $25 $29 reversed $6 $1 #")
(1 . "coedge $1 1 $1 $11 $28 $30 $31 forward $6 $1 #")
(1 . "coedge $1 1 $1 $32 $26 $11 $19 reversed $33 $1 #")
(1
.
"edge $1 1 $1 $34 5.3153917030455196 $35 0 $11 $36 forward 7 unknown #")
(1 . "face $1 1 $1 $37 $33 $3 $1 $38 forward single #")
(1 . "loop $1 1 $1 $1 $39 $12 #")
(1
.
"planesurface $1 1 $1 1.4927416835133442 2.0000000000000071 4.047548757442172 0.99042027662361654 3.6622761598738537e032 0.13808575470626536 3.0661196849527505e017 1 2.1991747903263115e016 forward\037v I I I I #")
(1 . "coedge $1 1 $1 $40 $41 $42 $43 forward $13 $1 #")
(1 . "coedge $1 1 $1 $44 $15 $41 $45 reversed $9 $1 #")
(1 . "coedge $1 1 $1 $15 $44 $16 $29 forward $9 $1 #")
(1 . "coedge $1 1 $1 $18 $42 $15 $27 reversed $33 $1 #")
(1
.
"edge $1 1 $1 $35 9.3264950579795212 $46 0 $15 $47 forward 7 unknown #")
(1 . "coedge $1 1 $1 $17 $16 $48 $49 forward $6 $1 #")
(1 .
"edge $1 1 $1 $50 0 $35 4 $25 $51 forward 7 unknown #")
(1 . "coedge $1 1 $1 $52 $39 $17 $31 reversed $21 $1 #")
(1 .
"edge $1 1 $1 $53 0 $34 4 $17 $54 forward 7 unknown #")
(1 . "coedge $1 1 $1 $42 $18 $39 $55 reversed $33 $1 #")
(1 . "loop $1 1 $1 $1 $18 $20 #")
(1 . "vertex $1 1 $1 $31 2 $56 #")
(1 . "vertex $1 1 $1 $29 2 $57 #")
(1
.
"straightcurve $1 1 $1 0.94194586084974929 1.9999999999999929 5.7086032045888881 0.60269152028716155 1.5700924586837584e016 0.79797426736327159 I I #")
(1 . "face $1 1 $1 $1 $58 $3 $1 $59 reversed single #")
(1
.
"planesurface $1 1 $1 0.092479475236885378 1.9999999999999929 0.32606642202224201 3.0661196849527505e017 1 2.1991747903263115e016 0.13808575470626533 2.2204460492503131e016 0.99042027662361631 forward\037v I I I I #")
(1 . "coedge $1 1 $1 $30 $60 $32 $55 forward $21 $1 #")
(1 . "coedge $1 1 $1 $61 $23 $60 $62 reversed $13 $1 #")
(1 . "coedge $1 1 $1 $23 $61 $24 $45 forward $13 $1 #")
(1 . "coedge $1 1 $1 $26 $32 $23 $43 reversed $33 $1 #")
(1
.
"edge $1 1 $1 $46 3.7585495178862374 $63 0 $23 $64 forward 7 unknown #")
(1 . "coedge $1 1 $1 $25 $24 $65 $66 forward $9 $1 #")
(1 .
"edge $1 1 $1 $67 0 $46 4 $41 $68 forward 7 unknown #")
(1 . "vertex $1 1 $1 $45 2 $69 #")
(1
.
"straightcurve $1 1 $1 2.229801969695103 1.9999999999999929 3.5285466106639802 0.13808575470626533 2.2204460492503126e016 0.99042027662361631 I I #")
(1 . "coedge $1 1 $1 $65 $70 $28 $49 reversed $58 $1 #")
(1
.
"edge $1 1 $1 $50 0 $53 5.3153917030455196 $48 $71 forward 7 unknown #")
(1 . "vertex $1 1 $1 $66 2 $72 #")
(1
.
"straightcurve $1 1 $1 0.94194586084974929 2.0000000000000071 5.7086032045888881 3.0661196849527505e017 1 2.1991747903263115e016 I I #")
(1 . "coedge $1 1 $1 $60 $30 $70 $73 forward $21 $1 #")
(1 . "vertex $1 1 $1 $73 2 $74 #")
(1
.
"straightcurve $1 1 $1 2.2615956455805204 2.0000000000000071 1.4670574046023415 3.0661196849527505e017 1 2.1991747903263115e016 I I #")
(1
.
"edge $1 1 $1 $63 5.567945540093362 $34 0 $39 $75 forward 7 unknown #")
(1
.
"point $1 1 $1 2.2615956455805204 1.9999999999999929 1.4670574046023415 #")
(1
.
"point $1 1 $1 0.94194586084974929 1.9999999999999929 5.7086032045888881 #")
(1 . "loop $1 1 $1 $1 $70 $37 #")
(1
.
"planesurface $1 1 $1 0.092479475236885378 2.0000000000000071 0.32606642202224201 3.0661196849527505e017 1 2.1991747903263115e016 0.13808575470626533 2.2204460492503131e016 0.99042027662361631 forward\037v I I I I #")
(1 . "coedge $1 1 $1 $39 $52 $40 $62 forward $21 $1 #")
(1 . "coedge $1 1 $1 $41 $40 $76 $77 forward $13 $1 #")
(1 .
"edge $1 1 $1 $78 0 $63 4 $60 $79 forward 7 unknown #")
(1 . "vertex $1 1 $1 $62 2 $80 #")
(1
.
"straightcurve $1 1 $1 1.4927416835133442 1.9999999999999929 4.047548757442172 0.99042027662361631 3.6622761598738532e032 0.13808575470626533 I I #")
(1 . "coedge $1 1 $1 $76 $48 $44 $66 reversed $58 $1 #")
(1
.
"edge $1 1 $1 $67 0 $50 9.3264950579795212 $65 $81 forward 7 unknown #")
(1 . "vertex $1 1 $1 $77 2 $82 #")
(1
.
"straightcurve $1 1 $1 2.229801969695103 2.0000000000000071 3.5285466106639802 3.0661196849527505e017 1 2.1991747903263115e016 I I #")
(1
.
"point $1 1 $1 2.229801969695103 1.9999999999999929 3.5285466106639802 #")
(1 . "coedge $1 1 $1 $48 $76 $52 $73 reversed $58 $1 #")
(1
.
"straightcurve $1 1 $1 0.94194586084974929 2.0000000000000071 5.7086032045888881 0.60269152028716155 1.5700924586837584e016 0.79797426736327159 I I #")
(1
.
"point $1 1 $1 0.94194586084974929 2.0000000000000071 5.7086032045888881 #")
(1
.
"edge $1 1 $1 $53 0 $78 5.567945540093362 $70 $83 forward 7 unknown #")
(1
.
"point $1 1 $1 2.2615956455805204 2.0000000000000071 1.4670574046023415 #")
(1
.
"straightcurve $1 1 $1 2.2615956455805204 1.9999999999999929 1.4670574046023415 0.13808575470626533 2.2204460492503126e016 0.99042027662361631 I I #")
(1 . "coedge $1 1 $1 $70 $65 $61 $77 reversed $58 $1 #")
(1
.
"edge $1 1 $1 $78 0 $67 3.7585495178862374 $76 $84 forward 7 unknown #")
(1 . "vertex $1 1 $1 $73 2 $85 #")
(1
.
"straightcurve $1 1 $1 1.4927416835133442 2.0000000000000071 4.047548757442172 3.0661196849527505e017 1 2.1991747903263115e016 I I #")
(1
.
"point $1 1 $1 1.4927416835133442 1.9999999999999929 4.047548757442172 #")
(1
.
"straightcurve $1 1 $1 2.229801969695103 2.0000000000000071 3.5285466106639802 0.13808575470626533 2.2204460492503126e016 0.99042027662361631 I I #")
(1
.
"point $1 1 $1 2.229801969695103 2.0000000000000071 3.5285466106639802 #")
(1
.
"straightcurve $1 1 $1 2.2615956455805204 2.0000000000000071 1.4670574046023415 0.13808575470626533 2.2204460492503126e016 0.99042027662361631 I I #")
(1
.
"straightcurve $1 1 $1 1.4927416835133442 2.0000000000000071 4.047548757442172 0.99042027662361631 3.6622761598738532e032 0.13808575470626533 I I #")
(1
.
"point $1 1 $1 1.4927416835133442 2.0000000000000071 4.047548757442172 #")
(100 . "AcDb3dSolid")
(350 . <Entity name: 0>))

Lot's of info in there.

Lot's of info in there.
yes.
for example I am able to extract all the points and recreate the solid (the wire lines) and the heights are in the $78 & $63 for smaller height [5.567945540093362] and in the $67 & $35 the larger height [9.3264950579795212]
I'll keep playing...

Looks good.
Dave, can you give me an example of the volume being wrong, I just created a cube dimensioned below
100000 100000 100000
and the answer 1E+15 is correct

Looks good.
Dave, can you give me an example of the volume being wrong, I just created a cube dimensioned below
100000 100000 100000
and the answer 1E+15 is correct
Try this, it should come up wrong because it is not symmetrical AND not aligned to the WCS. I do not have any sort of debug code to see it anymore.

That one works vol =242.812500000004

An easier way than making a db of sections Dave would be to have the user create their custom shapes' polyline while they are in the wcs with the correct orientation before extrusion or they could create a block lib of the polyline shape you could easily write a routine for them to produce the solids from adding the data on the fly.
This would enable the end user to have a library of 'any' profile possible and you can attach the data at creation time.
I do remember one drawback with xdata though, if you slice an object and 'keep both sides', only one side gets to keep the data! This could be overcome easily though, I used to have some modeling tools that were very handy and a lot quicker than using acad commands for most modeling (drilling and cutting at lines etc).
I've attached an arx and a picky to play with, works in 2006 but as it's win32 in should work in nearly any version, I'll leave it there for a day or two.
Usual warnings apply! It is still in beta.

That one works vol =242.812500000004
Not sure man. It seems I get the same info square to WCS or not on massprop. Not as many places as you, but close enough. Perhaps the routine my programmers used was different. I remember the side being 3 5/8" on a funny rotation. I have heard and read about this issue from C++/ACAD programmers before that were very experienced. I just do not know enough about it to explain further. Sorry about that.
Mick, I will check it out soon. I have it downloaded. Thanks.
My code can handle this screw without issue:

I do remember one drawback with xdata though, if you slice an object and 'keep both sides', only one side gets to keep the data! This could be overcome easily though, I used to have some modeling tools that were very handy and a lot quicker than using acad commands for most modeling (drilling and cutting at lines etc).
I don't have the issue. Are you just talking about that world xdata code?

Actually Dave, you're right. I just did a quick test on an old model and it was if I used 'separate' after doing a polyline cut through a beam say and I needed to turn the solid into 2 pieces, a slice worked fine.