To all,
I have been playing around with the sectioning capabilities in .NET, but have hit a snag.
When working manually in AutoCAD , you can create a section plane (SECTIONPLANE command) and then by right-clicking on the section plane you can create a 2D section of the solids that are cut by the section plane. In the settings, you can then turn on background geometry and turn off hidden lines, this will create a 2D section that shows background geometry but hides lines that are hidden behind other solids.
The .NET API provides access to these same capabilities. However, I cannot achieve what is described above. It appears as though the GenerateSectionGeometry method can only be applied to a single solid, one-at-a-time. Therefore, when this method is used with the visiblity of background geometry set to true and the visibilty of hiddenlines set to false, it does hide lines on the backside of a solid but lines on a solid that should be hidden behind another solid are still visible. The desired behavior is that these lines-hidden-behind-solids should not be visible. Is this functionality achievable with the .NET API? I hope so.
I have attached my source code below. Please let me know if you see what I am doing wrong.
Imports System
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
<Assembly: CommandClass(GetType(Autodesk.AutoCAD.SectionTest.SOMRClass))>
Namespace Autodesk.AutoCAD.SectionTest
Public Class SOMRClass
<CommandMethod("view2d")> _
Public Sub SectionTest()
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acDocEd As Editor = acDoc.Editor
'set up prompt selection options
Dim acPromptSelOpt As PromptSelectionOptions = New PromptSelectionOptions()
acPromptSelOpt.MessageForAdding = vbLf & "Select entities to section: "
acPromptSelOpt.MessageForRemoval = vbLf & "Select entities to remove from selection set: "
acPromptSelOpt.RejectObjectsFromNonCurrentSpace = True
'create a typed value array to define the filter criteria, filter for 3dSolids and BlockReferences
Dim acTypValAr(2) As TypedValue
acTypValAr.SetValue(New TypedValue(DxfCode.Operator, "<or"), 0)
acTypValAr.SetValue(New TypedValue(DxfCode.Start, "3dsolid"), 1)
acTypValAr.SetValue(New TypedValue(DxfCode.Operator, "or>"), 2)
'assign filter criteria to a selectionfilter object
Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)
'ask the user to select an entity to section
Dim acSSPrompt As PromptSelectionResult = acDoc.Editor.GetSelection(acPromptSelOpt, acSelFtr)
If acSSPrompt.Status = PromptStatus.OK Then
'save selection set to acSS
Dim acSSet As SelectionSet = acSSPrompt.Value
'ask the user to select points to be used to define the section plane
Dim acPtsColl As Point3dCollection = New Point3dCollection()
Dim acPtPrompt As PromptPointResult = acDocEd.GetPoint(vbLf & "Pick first point for section: ")
If acPtPrompt.Status = PromptStatus.OK Then
acPtsColl.Add(acPtPrompt.Value)
Dim acPromptPtOpt As PromptPointOptions = New PromptPointOptions(vbLf & "Pick end point for section: ")
acPromptPtOpt.BasePoint = acPtPrompt.Value
acPromptPtOpt.UseBasePoint = True
acPtPrompt = acDocEd.GetPoint(acPromptPtOpt)
If acPtPrompt.Status = PromptStatus.OK Then
acPtsColl.Add(acPtPrompt.Value)
Try
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
'now let's create our section object
Dim acSect As Section = New Section(acPtsColl, Vector3d.ZAxis)
acSect.State = SectionState.Plane
acSect.SetHeight(SectionHeight.HeightAboveSectionLine, 3.0)
acSect.SetHeight(SectionHeight.HeightBelowSectionLine, 1.0)
'get modelspace
Dim acBlkTbl As BlockTable = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)
Dim acModelSp As BlockTableRecord = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
'the section must be added to the drwing
Dim acSectObjId As ObjectId = acModelSp.AppendEntity(acSect)
acTrans.AddNewlyCreatedDBObject(acSect, True)
'get the section settings for the section object
Dim acSecSettings As SectionSettings = acTrans.GetObject(acSect.Settings, OpenMode.ForWrite)
'set the section type
acSecSettings.CurrentSectionType = SectionType.Section2d
'get the object ID collection of all entities in the selection set
Dim acObjIdCol As ObjectIdCollection = SS2IdCol(acSSet)
'set the source objects
acSecSettings.SetSourceObjects(SectionType.Section2d, acObjIdCol)
'set all visibility settings to false to start with
acSecSettings.SetVisibility(SectionType.Section2d, SectionGeometry.BackgroundGeometry, False)
acSecSettings.SetVisibility(SectionType.Section2d, SectionGeometry.CurveTangencyLines, False)
acSecSettings.SetVisibility(SectionType.Section2d, SectionGeometry.ForegroundGeometry, False)
acSecSettings.SetVisibility(SectionType.Section2d, SectionGeometry.IntersectionFill, False)
acSecSettings.SetHiddenLine(SectionType.Section2d, SectionGeometry.BackgroundGeometry, False)
acSecSettings.SetHiddenLine(SectionType.Section2d, SectionGeometry.ForegroundGeometry, False)
acSecSettings.SetHatchVisibility(SectionType.Section2d, SectionGeometry.IntersectionFill, False)
'prompt user to select options for the visibility section settings
Dim pKeyOpts As PromptKeywordOptions = New PromptKeywordOptions("")
pKeyOpts.Message = vbLf & "Show background: "
pKeyOpts.Keywords.Add("Yes")
pKeyOpts.Keywords.Add("No")
pKeyOpts.AllowNone = False
Dim pKeyRes As PromptResult = acDocEd.GetKeywords(pKeyOpts)
If pKeyRes.Status = PromptStatus.OK Then
If pKeyRes.StringResult = "Yes" Then
'turn on visibility of background geometry
acSecSettings.SetVisibility(SectionType.Section2d, SectionGeometry.BackgroundGeometry, True)
'The user chose to show background, therefore ask the user whether they want to show hidden lines
Dim pKeyOpts2 As PromptKeywordOptions = New PromptKeywordOptions("")
pKeyOpts2.Message = vbLf & "Show hidden lines: "
pKeyOpts2.Keywords.Add("Yes")
pKeyOpts2.Keywords.Add("No")
pKeyOpts2.AllowNone = False
Dim pKeyRes2 As PromptResult = acDocEd.GetKeywords(pKeyOpts2)
If pKeyRes2.Status = PromptStatus.OK Then
If pKeyRes2.StringResult = "Yes" Then
'the user chose to show hidden lines
acSecSettings.SetHiddenLine(SectionType.Section2d, SectionGeometry.BackgroundGeometry, True)
End If
End If
End If
End If
'set generation options
acSecSettings.SetGenerationOptions(SectionType.Section2d, SectionGeneration.SourceSelectedObjects Or SectionGeneration.DestinationNewBlock)
'create a block that will store our generated section drawing
Dim sectblock As BlockTableRecord = New BlockTableRecord()
'set the name of the block to the next available block name in the form "2D_Section_###"
sectblock.Name = GetNextBlkName(acBlkTbl)
'upgrade the blocktable to allow changes
acBlkTbl.UpgradeOpen()
'add the new block to the block table
Dim sectBlockId As ObjectId = acBlkTbl.Add(sectblock)
acTrans.AddNewlyCreatedDBObject(sectblock, True)
For Each acObjId As ObjectId In acObjIdCol
Try
'get the entity, exception occurs heer
Dim acEnt As Entity = acTrans.GetObject(acObjId, OpenMode.ForRead)
'generate the section geometry
Dim flEnts As Array
Dim bgEnts As Array
Dim fgEnts As Array
Dim ftEnts As Array
Dim ctEnts As Array
acSect.GenerateSectionGeometry(acEnt, flEnts, bgEnts, fgEnts, ftEnts, ctEnts)
'add the geometry to the block
For Each flEnt As Entity In flEnts
sectblock.AppendEntity(flEnt)
acTrans.AddNewlyCreatedDBObject(flEnt, True)
Next
For Each bgEnt As Entity In bgEnts
sectblock.AppendEntity(bgEnt)
acTrans.AddNewlyCreatedDBObject(bgEnt, True)
Next
For Each fgEnt As Entity In fgEnts
sectblock.AppendEntity(fgEnt)
acTrans.AddNewlyCreatedDBObject(fgEnt, True)
Next
For Each ftEnt As Entity In ftEnts
sectblock.AppendEntity(ftEnt)
acTrans.AddNewlyCreatedDBObject(ftEnt, True)
Next
For Each ctEnt As Entity In ctEnts
sectblock.AppendEntity(ctEnt)
acTrans.AddNewlyCreatedDBObject(ctEnt, True)
Next
Catch ex As System.Exception
acDocEd.WriteMessage(vbLf & "Error: " & ex.Message)
End Try
Next
'insert the block into model space
Dim insertSuccess As Boolean = InsertSection(sectBlockId)
'commit the transaction
acTrans.Commit()
End Using
Catch ex As System.Exception
acDocEd.WriteMessage(vbLf & "Error: " & ex.Message)
End Try
End If
End If
End If
End Sub
'function to insert the created block into modelspace
Public Function InsertSection(ByVal acBlkTabRecId As ObjectId) As Boolean
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acEd As Editor = acDoc.Editor
Dim success As Boolean = True
Try
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
Dim pPtRes As PromptPointResult
Dim pPtOpts As PromptPointOptions = New PromptPointOptions("")
'prompt for the insertion point of the section block
pPtOpts.Message = vbLf & "Pick the insertion point for the section block: "
pPtRes = acEd.GetPoint(pPtOpts)
If pPtRes.Status = PromptStatus.OK Then
'extract the point
Dim BlkInsertPt As Point3d = pPtRes.Value
'create the block reference
Dim acNewBlkRef As BlockReference = New BlockReference(BlkInsertPt, acBlkTabRecId)
'prompt user for the scale factor
Dim pDblRes As PromptDoubleResult
Dim pDblOpts As PromptDoubleOptions = New PromptDoubleOptions("")
pDblOpts.Message = vbLf & "Enter the scale factor: "
pDblOpts.AllowNegative = False
pDblOpts.AllowZero = False
pDblOpts.DefaultValue = 1
pDblRes = acEd.GetDouble(pDblOpts)
If pDblRes.Status = PromptStatus.OK Then
'calculate the scale factor
Dim ScaleFact As Double = pDblRes.Value
'create the transformation matrix
Dim matTransform As Matrix3d = Matrix3d.Scaling(ScaleFact, BlkInsertPt)
'scale the block
acNewBlkRef.TransformBy(matTransform)
'get modelspace
Dim acBlkTbl As BlockTable = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)
Dim acModelSp As BlockTableRecord = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
'add teh block reference to the layout block table record
acModelSp.AppendEntity(acNewBlkRef)
'add the block reference to the transaction
acTrans.AddNewlyCreatedDBObject(acNewBlkRef, True)
End If
End If
'commit the transaction
acTrans.Commit()
End Using
Catch ex As System.Exception
acEd.WriteMessage(vbLf & "Error:" & ex.Message)
success = False
End Try
Return success
End Function
'function to take a selectionset and return an object id collection
Private Function SS2IdCol(ByVal acSSet As SelectionSet) As ObjectIdCollection
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acDocEd As Editor = acDoc.Editor
Dim acOBjIdColl As ObjectIdCollection = New ObjectIdCollection()
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
For Each acSSObj As SelectedObject In acSSet
acOBjIdColl.Add(acSSObj.ObjectId)
Next
End Using
Return acOBjIdColl
End Function
'function to get the next available block name in the form "2D_Section_###"
Private Function GetNextBlkName(ByVal acBlkTable As BlockTable) As String
Dim startString As String = "001"
Do While acBlkTable.Has("2D_Section_" & startString)
Dim nextInt As Integer = CInt(startString) + 1
startString = nextInt.ToString("000")
Loop
startString = "2D_Section_" & startString
Return startString
End Function
End Class
End Namespace