Dim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Autodesk.AutoCAD.DatabaseServices.Database = acDoc.Database
Dim ed As Editor = acDoc.Editor
Dim cucs As Matrix3d = ed.CurrentUserCoordinateSystem
ed.CurrentUserCoordinateSystem = Matrix3d.Identity
Dim rtpts As New List(Of Point3d)
Try
Do
' System.Windows.Forms.Application.DoEvents()
Dim Mpso As New PromptPointOptions(vbCr & "Insert Points")
'Dim Mpso As New PromptPointOptions(vbCr & "编号插入点")
Dim psr As PromptPointResult = ed.GetPoint(Mpso)
Dim selectpt As Point3d = Point3d.Origin
If psr.Status = PromptStatus.OK Then
selectpt = psr.Value
rtpts.Add(selectpt)
Else
Exit Do
End If
'' Start a transaction
'Using dblock As Autodesk.AutoCAD.ApplicationServices.DocumentLock = acDoc.LockDocument
' Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
' '' Open the Block table for read
' Dim acBlkTbl As BlockTable
' acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId,
' OpenMode.ForRead)
' '' Open the Block table record Model space for write
' Dim acBlkTblRec As BlockTableRecord
' acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace),
' OpenMode.ForWrite)
' '' Create a single-line text object
' Stone.Layer.EnsureLayer("Stone_Points", 3)
' Using acPoint As DBPoint = New DBPoint()
' acPoint.Position = selectpt
' acPoint.Layer = "Stone_Points"
' acBlkTblRec.AppendEntity(acPoint)
' acTrans.AddNewlyCreatedDBObject(acPoint, True)
' End Using
' '' Save the changes and dispose of the transaction
' acTrans.Commit()
' End Using
'End Using
Loop
Dim dbs As DBObjectCollection = ed.TraceBoundary(rtpts.First, True)
MsgBox(dbs.Count.ToString)
Catch ex As Exception
ed.CurrentUserCoordinateSystem = cucs
Finally
End Try
ed.CurrentUserCoordinateSystem = cucs
You will always get 0 count dbs. But if I replace the TraceBoundary function into the loop. It works welldim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Autodesk.AutoCAD.DatabaseServices.Database = acDoc.Database
Dim ed As Editor = acDoc.Editor
Dim cucs As Matrix3d = ed.CurrentUserCoordinateSystem
ed.CurrentUserCoordinateSystem = Matrix3d.Identity
Dim rtpts As New List(Of Point3d)
Try
Do
' System.Windows.Forms.Application.DoEvents()
Dim Mpso As New PromptPointOptions(vbCr & "Insert Points")
'Dim Mpso As New PromptPointOptions(vbCr & "编号插入点")
Dim psr As PromptPointResult = ed.GetPoint(Mpso)
Dim selectpt As Point3d = Point3d.Origin
If psr.Status = PromptStatus.OK Then
selectpt = psr.Value
Dim dbs As DBObjectCollection = ed.TraceBoundary(selectpt, True)
MsgBox(dbs.Count.ToString)
rtpts.Add(selectpt)
Else
Exit Do
End If
'' Start a transaction
'Using dblock As Autodesk.AutoCAD.ApplicationServices.DocumentLock = acDoc.LockDocument
' Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
' '' Open the Block table for read
' Dim acBlkTbl As BlockTable
' acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId,
' OpenMode.ForRead)
' '' Open the Block table record Model space for write
' Dim acBlkTblRec As BlockTableRecord
' acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace),
' OpenMode.ForWrite)
' '' Create a single-line text object
' Stone.Layer.EnsureLayer("Stone_Points", 3)
' Using acPoint As DBPoint = New DBPoint()
' acPoint.Position = selectpt
' acPoint.Layer = "Stone_Points"
' acBlkTblRec.AppendEntity(acPoint)
' acTrans.AddNewlyCreatedDBObject(acPoint, True)
' End Using
' '' Save the changes and dispose of the transaction
' acTrans.Commit()
' End Using
'End Using
Loop
Catch ex As Exception
ed.CurrentUserCoordinateSystem = cucs
Finally
End Try
ed.CurrentUserCoordinateSystem = cucs
Just as a test edit your first example by pulling out of the loopCode - Visual Basic: [Select]
Dim selectpt As Point3d = Point3d.Origin
then changeCode - Visual Basic: [Select]to
Dim dbs As DBObjectCollection = ed.TraceBoundary(rtpts.First, True) Code - Visual Basic: [Select]
Dim dbs As DBObjectCollection = ed.TraceBoundary(selectpt, True)