You might be want instead to select block within the crossingpolygon method,
if you've added just one block within, see if this helps:
<CommandMethod("TUR")> _
Public Shared Sub testUpdateRooms()
Dim blockname As String = "ROOM"
' chnage block name
Dim tagname As String = "ROOMAREA"
' change tag
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim filtpline As TypedValue() = New TypedValue(1) {New TypedValue(0, "lwpolyline"), New TypedValue(70, 1)}
Dim pres As PromptSelectionResult = ed.SelectAll(New SelectionFilter(filtpline))
If pres.Status <> PromptStatus.OK Then
Return
End If
Dim filtblock As TypedValue() = New TypedValue(1) {New TypedValue(0, "insert"), New TypedValue(2, blockname)}
Using tr As Transaction = doc.TransactionManager.StartTransaction()
For Each sobj As SelectedObject In pres.Value
Dim ent As DBObject = tr.GetObject(sobj.ObjectId, OpenMode.ForRead, False)
Dim pline As Polyline = TryCast(ent, Polyline)
If pline Is Nothing Then
Return
End If
Dim pts As New Point3dCollection()
For n As Integer = 0 To pline.NumberOfVertices - 2
pts.Add(pline.GetPoint3dAt(n))
Next
Dim res As PromptSelectionResult = ed.SelectCrossingPolygon(pts, New SelectionFilter(filtblock))
If res.Status <> PromptStatus.OK Then
Continue For
End If
Dim sset As SelectionSet = res.Value
If sset.Count = 0 Then
Continue For
End If
' if more than one block found, then make polyline to be cyan colored to select room with extrafluous blocks
If sset.Count > 1 Then
pline.UpgradeOpen()
pline.ColorIndex = 121
Else
Dim ids As ObjectId() = sset.GetObjectIds()
Dim blkobj As DBObject = tr.GetObject(ids(0), OpenMode.ForRead, False)
Dim bref As BlockReference = TryCast(blkobj, BlockReference)
If bref Is Nothing Then
Continue For
End If
Dim atts As AttributeCollection = bref.AttributeCollection
For Each id As ObjectId In atts
Dim attref As AttributeReference = DirectCast(tr.GetObject(id, OpenMode.ForRead, False), AttributeReference)
If attref.Tag = tagname Then
bref.UpgradeOpen()
attref.UpgradeOpen()
attref.TextString = Math.Round(pline.Area, 2).ToString() '' i.e. precision 2 decimals, or
' possible to use a field with pline area as well
attref.DowngradeOpen()
bref.DowngradeOpen()
End If
Next
End If
Next
tr.Commit()
End Using
End Sub
_____________________________________
C6309D9E0751D165D0934D0621DFF27919
