OK,
here is the code and I have attached a drawing with examples.
I rewrote the code to draw a polyline around the geometricextents of the BlockReference. Then itereate all TEXT or MTEXT object in model space and check for intersects.
I have the origianl blockreference that I am working with, run "DPL" to text the code. it should draw a polyline within the extents of the blockreference. Then attempt to check intersects with the MTEXT object right next to it. It want find any, although it should.
Example two, is the smaller polyline with MTEXT object on top of it. Type "inters" and you will see that intersections exist. These objects where drawn manually using normal polyline and mtext commands.
Example three is the larger polyline with the MTEXT object on top. Type "inters" and you will see that no intersections exist. The polyline was drawn by code from the "DPL" command. So, my code drawn polyline does not intersect with the MTEXT variable.
Why not. ????
Option Explicit On
Option Strict On
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Colors
Imports System.IO
Imports Microsoft.Win32
Imports System.Reflection
Public Class Class1
<CommandMethod("inters", CommandFlags.UsePickSet)> _
Public Sub GetInters()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim tr As Transaction = db.TransactionManager.StartTransaction
Try
Using tr
Dim acBT As BlockTable = CType(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim acMS As BlockTableRecord = CType(tr.GetObject(acBT(BlockTableRecord.ModelSpace), OpenMode.ForRead), BlockTableRecord)
Dim opt As New PromptEntityOptions(vbLf & "Select entity: ")
opt.SetRejectMessage(vbLf & "Error selecting entity")
opt.AllowNone = False
'opt.AddAllowedClass(GetType(BlockReference), True)
Dim res As PromptEntityResult = ed.GetEntity(opt)
If res.Status <> PromptStatus.OK Then Return
Dim lid As ObjectId = res.ObjectId
opt = New PromptEntityOptions(vbLf & "Select entity: ")
opt.SetRejectMessage(vbLf & "Error selecting entity")
'opt.AddAllowedClass(GetType(MText), True)
'opt.AddAllowedClass(GetType(DBText), True)
res = ed.GetEntity(opt)
If res.Status <> PromptStatus.OK Then Return
Dim pid As ObjectId = res.ObjectId
Dim pts As Point3dCollection = New Point3dCollection()
ed.WriteMessage(vbLf & "{0} <> {1};", lid, pid)
Dim ent1 As Entity = CType(tr.GetObject(lid, OpenMode.ForRead), Entity)
Dim ent2 As Entity = TryCast(tr.GetObject(pid, OpenMode.ForRead), Entity)
'Dim plane As Plane = New Plane(ed.CurrentUserCoordinateSystem.CoordinateSystem3d.Origin, ed.CurrentUserCoordinateSystem.CoordinateSystem3d.Zaxis)
'ent1.IntersectWith(ent2, Intersect.OnBothOperands, Plane, pts, 0, 0)
ent1.IntersectWith(ent2, Intersect.OnBothOperands, pts, 0, 0)
ed.WriteMessage(vbLf & "Number of intersections: {0}", pts.Count)
Dim i As Integer = 1
For Each pt As Point3d In pts
ed.WriteMessage(vbLf & "Point number {0}: ({1}, {2}, {3})", i, pt.X, pt.Y, pt.Z)
i += 1
Next
tr.Commit()
End Using
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage(vbLf & "{0}", ex.Message)
End Try
End Sub
''' <summary>
''' Draws a box around the extents of selected object
''' </summary>
''' <remarks></remarks>
<CommandMethod("DPL", CommandFlags.UsePickSet)> _
Public Sub DrawPolyLine()
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acDB As Database = acDoc.Database
Dim acDocEd As Editor = acDoc.Editor
Dim tr As Transaction = acDB.TransactionManager.StartTransaction
Try
Using tr
Dim acBT As BlockTable = CType(tr.GetObject(acDB.BlockTableId, OpenMode.ForRead), BlockTable)
Dim acMS As BlockTableRecord = CType(tr.GetObject(acBT(BlockTableRecord.ModelSpace), OpenMode.ForRead), BlockTableRecord)
Dim opt As New PromptEntityOptions(vbLf & "Select block: ")
opt.SetRejectMessage(vbLf & "Only Block Reference allowed...")
opt.AllowNone = False
opt.AddAllowedClass(GetType(BlockReference), True)
Dim res As PromptEntityResult = acDocEd.GetEntity(opt)
If res.Status <> PromptStatus.OK Then Return
Dim blkID As ObjectId = res.ObjectId
Dim acAttID As ObjectId
Dim acBlkRef As BlockReference = CType(tr.GetObject(blkID, OpenMode.ForRead), BlockReference)
Dim acAttRef As New AttributeReference
Dim strAttTemp As String = ""
Dim attIDs As AttributeCollection = acBlkRef.AttributeCollection
For Each attID As ObjectId In attIDs
acAttRef = CType(tr.GetObject(attID, OpenMode.ForRead), AttributeReference)
If acAttRef.Tag = "1" Then
acAttID = attID
strAttTemp = acAttRef.TextString
acAttRef.UpgradeOpen()
acAttRef.TextString = "XXXXXXXXXX"
acAttRef.DowngradeOpen()
End If
Next
Dim ext3D As Extents3d = acBlkRef.GeometricExtents
Dim dWidth As Double = (ext3D.MaxPoint.Y - ext3D.MinPoint.Y)
Dim plStartPnt As Point2d = New Point2d(ext3D.MinPoint.X, ext3D.MinPoint.Y + dWidth / 2)
Dim plEndPnt As Point2d = New Point2d(ext3D.MaxPoint.X, ext3D.MinPoint.Y + dWidth / 2)
Dim pl As Polyline = New Polyline
pl.AddVertexAt(0, plStartPnt, 0, dWidth, dWidth)
pl.AddVertexAt(0, plEndPnt, 0, dWidth, dWidth)
'If acAttRef IsNot Nothing Then
acAttRef.UpgradeOpen()
acAttRef.TextString = strAttTemp
acAttRef.DowngradeOpen()
'End If
acMS.UpgradeOpen()
acMS.AppendEntity(pl)
tr.AddNewlyCreatedDBObject(pl, True)
acMS.DowngradeOpen()
acDocEd.Regen()
'' Create a TypedValue array to define the filter criteria of Text or MText
Dim acTypValAr(3) As TypedValue
acTypValAr.SetValue(New TypedValue(DxfCode.Operator, "<or"), 0)
acTypValAr.SetValue(New TypedValue(DxfCode.Start, "TEXT"), 1)
acTypValAr.SetValue(New TypedValue(DxfCode.Start, "MTEXT"), 2)
acTypValAr.SetValue(New TypedValue(DxfCode.Operator, "or>"), 3)
'' Assign the filter criteria to a SelectionFilter object
Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)
'' Request for objects to be selected in the drawing area
Dim acSSPrompt As PromptSelectionResult
acSSPrompt = acDocEd.SelectAll(acSelFtr)
'' If the prompt status is OK, objects were selected
If acSSPrompt.Status = PromptStatus.OK Then
Dim acSSet As SelectionSet = acSSPrompt.Value
Dim acObjIDs As ObjectId() = acSSet.GetObjectIds
For Each acObjID As ObjectId In acObjIDs
If acObjID.ObjectClass.Name = "AcDbText" Then
Dim acText As DBText = CType(tr.GetObject(acObjID, OpenMode.ForRead), DBText)
Dim colPnts As New Point3dCollection
pl.IntersectWith(CType(acText, Entity), Intersect.OnBothOperands, colPnts, 0, 0)
If colPnts.Count > 0 Then
acDocEd.WriteMessage(acText.TextString)
End If
Else
Dim acMText As MText = CType(tr.GetObject(acObjID, OpenMode.ForRead), MText)
Dim colPnts As New Point3dCollection
pl.IntersectWith(CType(acMText, Entity), Intersect.OnBothOperands, colPnts, 0, 0)
If colPnts.Count > 0 Then
acDocEd.WriteMessage(acMText.Text)
End If
End If
Next
End If
tr.Commit()
End Using
Catch ex As Autodesk.AutoCAD.Runtime.Exception
acDocEd.WriteMessage(vbLf & "{0}", ex.Message)
End Try
End Sub
End Class
)
