Exceeded Stack Limit

[SOMAR_engineering]

I have been working on this .NET routine for quite a while and am stumped. I am relatively new to .NET programming, and have truly tried to figure this out on my own and have consulted the archive of the DB and the documentation that I have available, but need a little help to get me on the right track.

What I am trying to accomplish: The code below prompts the user to select a 3D solid and then to specify a spacing value. The routine then enters a Do Loop where the solid is sliced at each spacing value and the leftover solid deleted. The finished result is a series of sections that are equally spaced. I have attached an image showing the starting solid and the final desired result.

The routine works well as written as long as the total number of sections are kept small. If I increase the number of sections (by decreasing the spacing between sections), I get an "exceeded stack limit" error. The complexity of the sections also play a part of course. I do not understand why I would be running out of memory. Each transaction seems to me to be properly disposed of. Each transaction does not seem (to me) to be trying to do too much. There are transactions within transactions though, since outside functions containing transactions are being called from within transactions.

I am probably missing the obvious. Please point me in the right direction.

Thanks,
Will Massie

ACAD 2007
VB.NET 2005 Express Edition
Win2000

{code}
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Colors

Public Class SOMRClass

' Define command 'Createsections'
_
Public Sub Createsections()

Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acEd As Editor = acDoc.Editor
Dim acCurDb As Database = acDoc.Database

'select the 3D Solid
Dim CurSolidId As ObjectId = EntSelect(vbCrLf & "Select a 3D Solid: ", GetType(Solid3d), vbCrLf & "Select only a 3D Solid!")

'input spacing between sections
Dim prIntOps As New PromptIntegerOptions(vbCrLf & "Enter the spacing between sections in whole inches (integer value expected): ")
prIntOps.AllowZero = False
prIntOps.AllowNegative = False
prIntOps.AllowNone = False
Dim mySpacing As Integer = acEd.GetInteger(prIntOps).Value

'initialize variables
Dim FirstTime As Boolean = True
Dim ColorCount As Integer = 1
Dim CurSolid As Solid3d = Nothing
Dim SpacingSum As Double = mySpacing
Dim SolidLength As Double
Dim planePoint1 As Point3d
Dim planePoint2 As Point3d
Dim planePoint3 As Point3d
'start do loop
Do
'Start transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
Try
If CurSolidId.IsValid Then
'get the current or remaining solid object from the objectID
CurSolid = acTrans.GetObject(CurSolidId, OpenMode.ForWrite)
End If
If FirstTime Then
'determine total length of the solid, rounded to the nearest whole inch
SolidLength = Math.Round(CurSolid.GeometricExtents.MaxPoint.X)
'if the spacing value exceeds the length of the solid show error message and exit
If SpacingSum > SolidLength Then
acEd.WriteMessage(vbCrLf & "Spacing cannot exceed the length of the solid!")
acTrans.Abort()
acTrans.Dispose()
Exit Do
End If
If SpacingSum = SolidLength Then
'explode and erase all unneeded entities
FwdSection(CurSolid, SpacingSum - mySpacing, SpacingSum, True, ColorCount)
'erase the solid that was exploded
CurSolid.Erase()
FirstTime = False
Else
'define points for the slicing plane
planePoint1 = New Point3d(SpacingSum, 0.0, 0.0)
planePoint2 = New Point3d(SpacingSum, 1.0, 0.0)
planePoint3 = New Point3d(SpacingSum, 0.0, 1.0)
'perform the slice and return the objectId of the remaining solid,
'will return CurSolidId = Nothing if slice fails
CurSolidId = Slice3D(CurSolid, mySpacing, planePoint1, planePoint2, planePoint3)
If CurSolidId.IsValid Then
'explode and erase all unneeded entities
FwdSection(CurSolid, SpacingSum - mySpacing, SpacingSum, False, ColorCount)
'erase the solid that was exploded
CurSolid.Erase()
End If
FirstTime = False
End If
Else
If SpacingSum = SolidLength Then
Dim LastSpaceFwdPos As Double = Nothing
If (Math.Truncate(SolidLength / mySpacing)) * mySpacing = SpacingSum Then
LastSpaceFwdPos = SolidLength - mySpacing
Else
LastSpaceFwdPos = (Math.Truncate(SolidLength / mySpacing)) * mySpacing
End If
FwdSection(CurSolid, LastSpaceFwdPos, SpacingSum, True, ColorCount)
CurSolid.Erase()
Else
'define points for the slicing plane
planePoint1 = New Point3d(SpacingSum, 0.0, 0.0)
planePoint2 = New Point3d(SpacingSum, 1.0, 0.0)
planePoint3 = New Point3d(SpacingSum, 0.0, 1.0)
'perform the slice and return the objectId of the remaining solid,
'will return CurSolidId = Nothing if slice fails
CurSolidId = Slice3D(CurSolid, mySpacing, planePoint1, planePoint2, planePoint3)
If CurSolidId.IsValid Then
'explode and erase all unneeded entities
'and place remaining entites on new layer
FwdSection(CurSolid, SpacingSum - mySpacing, SpacingSum, False, ColorCount)
'erase the solid that was exploded
CurSolid.Erase()
End If
End If
End If

If SolidLength - SpacingSum < mySpacing Then
If SpacingSum = SolidLength Then
acTrans.Commit()
acTrans.Dispose()
Exit Do
Else
SpacingSum = SolidLength
End If
Else
'increment the spacing sum
SpacingSum = SpacingSum + mySpacing
End If
'commit the transaction
acTrans.Commit()
Catch ex As Exception
acDoc.Editor.WriteMessage(vbCrLf & ex.Message & "In: " & ex.Source & vbCrLf & vbCrLf & ex.StackTrace)
acTrans.Abort()
acTrans.Dispose()
End Try
End Using
Loop While SpacingSum <= SolidLength
End Sub

Public Function EntSelect(ByVal PromptString As String, ByVal AllowedType As System.Type, _
ByVal RejectMsg As String) As ObjectId

Dim SelObj As ObjectId = Nothing
Dim acEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Try
Dim prEntOps As New PromptEntityOptions(PromptString)
Dim prEntRes As PromptEntityResult
prEntOps.SetRejectMessage(RejectMsg)
prEntOps.AddAllowedClass(AllowedType, False)
prEntOps.AllowNone = False
prEntOps.AllowObjectOnLockedLayer = False
prEntOps.AppendKeywordsToMessage = False
prEntRes = acEd.GetEntity(prEntOps)
If prEntRes.Status <> PromptStatus.OK Then Return SelObj
SelObj = prEntRes.ObjectId
Return SelObj
Catch ex As Exception
acEd.WriteMessage(vbCrLf & ex.Message & "In: " & ex.Source & vbCrLf & vbCrLf & ex.StackTrace)
Return SelObj
Finally
acEd = Nothing
End Try
End Function

Private Function Slice3D(ByVal acSolid As Solid3d, ByVal Spacing As Double, _
ByVal planePoint1 As Point3d, ByVal planePoint2 As Point3d, _
ByVal planePoint3 As Point3d) As ObjectId
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim otherSolObjId As ObjectId = Nothing
Dim SlicePlane As Plane = New Plane(planePoint1, planePoint2, planePoint3)
Using acTrans As Transaction = acDoc.TransactionManager.StartTransaction()
Try
Dim otherSolid As Solid3d = acSolid.Slice(SlicePlane, True)
Dim acBlkTbl As BlockTable = acTrans.GetObject(acDoc.Database.BlockTableId, OpenMode.ForRead)
Dim acBlkTblRec As BlockTableRecord = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
acBlkTblRec.AppendEntity(otherSolid)
acTrans.AddNewlyCreatedDBObject(otherSolid, True)
acTrans.Commit()
Dim acPromptSelRes As PromptSelectionResult = acDoc.Editor.SelectLast()
otherSolObjId = acPromptSelRes.Value.Item(0).ObjectId
Catch ex As Exception
acDoc.Editor.WriteMessage(vbCrLf & ex.Message & "In: " & ex.Source & vbCrLf & vbCrLf & ex.StackTrace)
acTrans.Abort()
acTrans.Dispose()
End Try
End Using
Return otherSolObjId
End Function

Public Function FwdSection(ByVal acSolid3d As Solid3d, ByVal acFrontXVal As Double, ByVal acBackXVal As Double, ByVal IncludeBack As Boolean, ByRef ColorCount As Integer) As DBObjectCollection
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acDBObjColl As DBObjectCollection = New DBObjectCollection()
'start a transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
Try
'open the block table for read
Dim acBlkTbl As BlockTable = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)
'open the blocktable record Modelspace for write
Dim acBlkTblRec As BlockTableRecord = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
'explode the solid
acSolid3d.Explode(acDBObjColl)
For Each acEnt As Entity In acDBObjColl
'determine whether the it is perpendicular to x-axis
Dim EntMaxXPt As Double = Math.Round(acEnt.GeometricExtents.MaxPoint.X)
Dim EntMinXPt As Double = Math.Round(acEnt.GeometricExtents.MinPoint.X)
If EntMaxXPt = EntMinXPt Then
If EntMaxXPt = acFrontXVal Or (IncludeBack And EntMaxXPt = acBackXVal) Then
'color count can only go up to 247, once it has reached that
'value, then return back to 1
If ColorCount > 247 Then
ColorCount = 1
End If
'if this is the last section in the solid,
'set layer name to the back section x value
'otherwise set it to the front section x value
If EntMaxXPt = acBackXVal Then
'create layer and add entity to layer
CreateAndAssignLayer(acEnt, "SECTION" & CStr(CInt(acBackXVal)), Color.FromColorIndex(ColorMethod.ByAci, ColorCount))
Else
'create layer and add entity to layer
CreateAndAssignLayer(acEnt, "SECTION" & CStr(CInt(acFrontXVal)), Color.FromColorIndex(ColorMethod.ByAci, ColorCount))
End If

'add the new object to the block table record and the transaction
acBlkTblRec.AppendEntity(acEnt)
acTrans.AddNewlyCreatedDBObject(acEnt, True)
'increment color count by 1
ColorCount += 1
End If
End If
Next
acTrans.Commit()
Catch ex As Exception
acDoc.Editor.WriteMessage(vbCrLf & ex.Message & "In: " & ex.Source & vbCrLf & vbCrLf & ex.StackTrace)
acTrans.Abort()
acTrans.Dispose()
End Try
End Using
Return acDBObjColl
End Function

Public Function CreateAndAssignLayer(ByVal acEnt As Entity, ByVal LayerName As String, ByVal LayerColor As Color) As LayerTableRecord
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acLyrTblRec As LayerTableRecord = New LayerTableRecord()
'Start transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
Try
Dim acLyrTbl As LayerTable = acTrans.GetObject(acCurDb.LayerTableId, OpenMode.ForRead)
If acLyrTbl.Has(LayerName) = False Then
'assign the layer color and name
acLyrTblRec.Color = LayerColor
acLyrTblRec.Name = LayerName
'upgrade the layer table for write
acLyrTbl.UpgradeOpen()

'append the new layer to the layer table and the tranaction
acLyrTbl.Add(acLyrTblRec)
acTrans.AddNewlyCreatedDBObject(acLyrTblRec, True)
Else
acLyrTblRec = acTrans.GetObject(acLyrTbl(LayerName), OpenMode.ForRead)
End If
'change the entity to the new layer
acEnt.Layer = LayerName
acTrans.Commit()
Catch ex As Exception
acDoc.Editor.WriteMessage(vbCrLf & ex.Message & "In: " & ex.Source & vbCrLf & vbCrLf & ex.StackTrace)
acTrans.Abort()
acTrans.Dispose()
End Try
End Using
Return acLyrTblRec
End Function
End Class
{code}

[Anonymous]

I don't have time to go through all of your code to try and figure out what's
going wrong, other than to tell you that I see too many errors to list each in
detail. One of the most dangerous errors, is where you explode the solid, and
then loop through each resulting entity, and add *some* but not all of them to a
database. The ones you don't add to the drawing you simply ignore and don't
bother calling Dispose() on , which usually leads to a fatal error.


--
http://www.caddzone.com

AcadXTabs: MDI Document Tabs for AutoCAD
Supporting AutoCAD 2000 through 2010

http://www.acadxtabs.com

Email: string.Format("{0}@{1}.com", "tonyt", "caddzone");

wrote in message news:6336924@discussion.autodesk.com...
I have been working on this .NET routine for quite a while and am stumped. I am
relatively new to .NET programming, and have truly tried to figure this out on
my own and have consulted the archive of the DB and the documentation that I
have available, but need a little help to get me on the right track.

What I am trying to accomplish: The code below prompts the user to select a 3D
solid and then to specify a spacing value. The routine then enters a Do Loop
where the solid is sliced at each spacing value and the leftover solid deleted.
The finished result is a series of sections that are equally spaced. I have
attached an image showing the starting solid and the final desired result.

The routine works well as written as long as the total number of sections are
kept small. If I increase the number of sections (by decreasing the spacing
between sections), I get an "exceeded stack limit" error. The complexity of the
sections also play a part of course. I do not understand why I would be running
out of memory. Each transaction seems to me to be properly disposed of. Each
transaction does not seem (to me) to be trying to do too much. There are
transactions within transactions though, since outside functions containing
transactions are being called from within transactions.

I am probably missing the obvious. Please point me in the right direction.

Thanks,
Will Massie

ACAD 2007
VB.NET 2005 Express Edition
Win2000

{code}
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Colors

Public Class SOMRClass

' Define command 'Createsections'
_
Public Sub Createsections()

Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acEd As Editor = acDoc.Editor
Dim acCurDb As Database = acDoc.Database

'select the 3D Solid
Dim CurSolidId As ObjectId = EntSelect(vbCrLf & "Select a 3D Solid: ",
GetType(Solid3d), vbCrLf & "Select only a 3D Solid!")

'input spacing between sections
Dim prIntOps As New PromptIntegerOptions(vbCrLf & "Enter the spacing
between sections in whole inches (integer value expected): ")
prIntOps.AllowZero = False
prIntOps.AllowNegative = False
prIntOps.AllowNone = False
Dim mySpacing As Integer = acEd.GetInteger(prIntOps).Value

'initialize variables
Dim FirstTime As Boolean = True
Dim ColorCount As Integer = 1
Dim CurSolid As Solid3d = Nothing
Dim SpacingSum As Double = mySpacing
Dim SolidLength As Double
Dim planePoint1 As Point3d
Dim planePoint2 As Point3d
Dim planePoint3 As Point3d
'start do loop
Do
'Start transaction
Using acTrans As Transaction =
acCurDb.TransactionManager.StartTransaction()
Try
If CurSolidId.IsValid Then
'get the current or remaining solid object from the
objectID
CurSolid = acTrans.GetObject(CurSolidId,
OpenMode.ForWrite)
End If
If FirstTime Then
'determine total length of the solid, rounded to the
nearest whole inch
SolidLength =
Math.Round(CurSolid.GeometricExtents.MaxPoint.X)
'if the spacing value exceeds the length of the solid
show error message and exit
If SpacingSum > SolidLength Then
acEd.WriteMessage(vbCrLf & "Spacing cannot exceed
the length of the solid!")
acTrans.Abort()
acTrans.Dispose()
Exit Do
End If
If SpacingSum = SolidLength Then
'explode and erase all unneeded entities
FwdSection(CurSolid, SpacingSum - mySpacing,
SpacingSum, True, ColorCount)
'erase the solid that was exploded
CurSolid.Erase()
FirstTime = False
Else
'define points for the slicing plane
planePoint1 = New Point3d(SpacingSum, 0.0, 0.0)
planePoint2 = New Point3d(SpacingSum, 1.0, 0.0)
planePoint3 = New Point3d(SpacingSum, 0.0, 1.0)
'perform the slice and return the objectId of the
remaining solid,
'will return CurSolidId = Nothing if slice fails
CurSolidId = Slice3D(CurSolid, mySpacing,
planePoint1, planePoint2, planePoint3)
If CurSolidId.IsValid Then
'explode and erase all unneeded entities
FwdSection(CurSolid, SpacingSum - mySpacing,
SpacingSum, False, ColorCount)
'erase the solid that was exploded
CurSolid.Erase()
End If
FirstTime = False
End If
Else
If SpacingSum = SolidLength Then
Dim LastSpaceFwdPos As Double = Nothing
If (Math.Truncate(SolidLength / mySpacing)) *
mySpacing = SpacingSum Then
LastSpaceFwdPos = SolidLength - mySpacing
Else
LastSpaceFwdPos = (Math.Truncate(SolidLength /
mySpacing)) * mySpacing
End If
FwdSection(CurSolid, LastSpaceFwdPos, SpacingSum,
True, ColorCount)
CurSolid.Erase()
Else
'define points for the slicing plane
planePoint1 = New Point3d(SpacingSum, 0.0, 0.0)
planePoint2 = New Point3d(SpacingSum, 1.0, 0.0)
planePoint3 = New Point3d(SpacingSum, 0.0, 1.0)
'perform the slice and return the objectId of the
remaining solid,
'will return CurSolidId = Nothing if slice fails
CurSolidId = Slice3D(CurSolid, mySpacing,
planePoint1, planePoint2, planePoint3)
If CurSolidId.IsValid Then
'explode and erase all unneeded entities
'and place remaining entites on new layer
FwdSection(CurSolid, SpacingSum - mySpacing,
SpacingSum, False, ColorCount)
'erase the solid that was exploded
CurSolid.Erase()
End If
End If
End If

If SolidLength - SpacingSum < mySpacing Then
If SpacingSum = SolidLength Then
acTrans.Commit()
acTrans.Dispose()
Exit Do
Else
SpacingSum = SolidLength
End If
Else
'increment the spacing sum
SpacingSum = SpacingSum + mySpacing
End If
'commit the transaction
acTrans.Commit()
Catch ex As Exception
acDoc.Editor.WriteMessage(vbCrLf & ex.Message & "In: " &
ex.Source & vbCrLf & vbCrLf & ex.StackTrace)
acTrans.Abort()
acTrans.Dispose()
End Try
End Using
Loop While SpacingSum <= SolidLength
End Sub

Public Function EntSelect(ByVal PromptString As String, ByVal AllowedType As
System.Type, _
ByVal RejectMsg As String) As ObjectId

Dim SelObj As ObjectId = Nothing
Dim acEd As Editor =
Application.DocumentManager.MdiActiveDocument.Editor
Try
Dim prEntOps As New PromptEntityOptions(PromptString)
Dim prEntRes As PromptEntityResult
prEntOps.SetRejectMessage(RejectMsg)
prEntOps.AddAllowedClass(AllowedType, False)
prEntOps.AllowNone = False
prEntOps.AllowObjectOnLockedLayer = False
prEntOps.AppendKeywordsToMessage = False
prEntRes = acEd.GetEntity(prEntOps)
If prEntRes.Status <> PromptStatus.OK Then Return SelObj
SelObj = prEntRes.ObjectId
Return SelObj
Catch ex As Exception
acEd.WriteMessage(vbCrLf & ex.Message & "In: " & ex.Source & vbCrLf
& vbCrLf & ex.StackTrace)
Return SelObj
Finally
acEd = Nothing
End Try
End Function

Private Function Slice3D(ByVal acSolid As Solid3d, ByVal Spacing As Double,
_
ByVal planePoint1 As Point3d, ByVal planePoint2 As Point3d, _
ByVal planePoint3 As Point3d) As ObjectId
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim otherSolObjId As ObjectId = Nothing
Dim SlicePlane As Plane = New Plane(planePoint1, planePoint2,
planePoint3)
Using acTrans As Transaction =
acDoc.TransactionManager.StartTransaction()
Try
Dim otherSolid As Solid3d = acSolid.Slice(SlicePlane, True)
Dim acBlkTbl As BlockTable =
acTrans.GetObject(acDoc.Database.BlockTableId, OpenMode.ForRead)
Dim acBlkTblRec As BlockTableRecord =
acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
acBlkTblRec.AppendEntity(otherSolid)
acTrans.AddNewlyCreatedDBObject(otherSolid, True)
acTrans.Commit()
Dim acPromptSelRes As PromptSelectionResult =
acDoc.Editor.SelectLast()
otherSolObjId = acPromptSelRes.Value.Item(0).ObjectId
Catch ex As Exception
acDoc.Editor.WriteMessage(vbCrLf & ex.Message & "In: " &
ex.Source & vbCrLf & vbCrLf & ex.StackTrace)
acTrans.Abort()
acTrans.Dispose()
End Try
End Using
Return otherSolObjId
End Function

Public Function FwdSection(ByVal acSolid3d As Solid3d, ByVal acFrontXVal As
Double, ByVal acBackXVal As Double, ByVal IncludeBack As Boolean, ByRef
ColorCount As Integer) As DBObjectCollection
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acDBObjColl As DBObjectCollection = New DBObjectCollection()
'start a transaction
Using acTrans As Transaction =
acCurDb.TransactionManager.StartTransaction()
Try
'open the block table for read
Dim acBlkTbl As BlockTable =
acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)
'open the blocktable record Modelspace for write
Dim acBlkTblRec As BlockTableRecord =
acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
'explode the solid
acSolid3d.Explode(acDBObjColl)
For Each acEnt As Entity In acDBObjColl
'determine whether the it is perpendicular to x-axis
Dim EntMaxXPt As Double =
Math.Round(acEnt.GeometricExtents.MaxPoint.X)
Dim EntMinXPt As Double =
Math.Round(acEnt.GeometricExtents.MinPoint.X)
If EntMaxXPt = EntMinXPt Then
If EntMaxXPt = acFrontXVal Or (IncludeBack And EntMaxXPt
= acBackXVal) Then
'color count can only go up to 247, once it has
reached that
'value, then return back to 1
If ColorCount > 247 Then
ColorCount = 1
End If
'if this is the last section in the solid,
'set layer name to the back section x value
'otherwise set it to the front section x value
If EntMaxXPt = acBackXVal Then
'create layer and add entity to layer
CreateAndAssignLayer(acEnt, "SECTION" &
CStr(CInt(acBackXVal)), Color.FromColorIndex(ColorMethod.ByAci, ColorCount))
Else
'create layer and add entity to layer
CreateAndAssignLayer(acEnt, "SECTION" &
CStr(CInt(acFrontXVal)), Color.FromColorIndex(ColorMethod.ByAci, ColorCount))
End If

'add the new object to the block table record and
the transaction
acBlkTblRec.AppendEntity(acEnt)
acTrans.AddNewlyCreatedDBObject(acEnt, True)
'increment color count by 1
ColorCount += 1
End If
End If
Next
acTrans.Commit()
Catch ex As Exception
acDoc.Editor.WriteMessage(vbCrLf & ex.Message & "In: " &
ex.Source & vbCrLf & vbCrLf & ex.StackTrace)
acTrans.Abort()
acTrans.Dispose()
End Try
End Using
Return acDBObjColl
End Function

Public Function CreateAndAssignLayer(ByVal acEnt As Entity, ByVal LayerName
As String, ByVal LayerColor As Color) As LayerTableRecord
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acLyrTblRec As LayerTableRecord = New LayerTableRecord()
'Start transaction
Using acTrans As Transaction =
acCurDb.TransactionManager.StartTransaction()
Try
Dim acLyrTbl As LayerTable =
acTrans.GetObject(acCurDb.LayerTableId, OpenMode.ForRead)
If acLyrTbl.Has(LayerName) = False Then
'assign the layer color and name
acLyrTblRec.Color = LayerColor
acLyrTblRec.Name = LayerName
'upgrade the layer table for write
acLyrTbl.UpgradeOpen()

'append the new layer to the layer table and the tranaction
acLyrTbl.Add(acLyrTblRec)
acTrans.AddNewlyCreatedDBObject(acLyrTblRec, True)
Else
acLyrTblRec = acTrans.GetObject(acLyrTbl(LayerName),
OpenMode.ForRead)
End If
'change the entity to the new layer
acEnt.Layer = LayerName
acTrans.Commit()
Catch ex As Exception
acDoc.Editor.WriteMessage(vbCrLf & ex.Message & "In: " &
ex.Source & vbCrLf & vbCrLf & ex.StackTrace)
acTrans.Abort()
acTrans.Dispose()
End Try
End Using
Return acLyrTblRec
End Function
End Class
{code}

[_gile]

Hi,

May be set the SOLIDHIST sysvar to 0.

Why not using the Solid3d.GetSection(Plane plane) method rather than a slice and erase destructive method ?

[SOMAR_engineering]

Thanks for the comments above. They are all very helpful. I will take these and see if I can improve my routine. Any other comments are welcome.