Bounding Boxes around Blocks.
https://forums.autodesk.com/t5/net/bou ... und-blocks/td-p/3822317 <CommandMethod("BBO")> _
Public Sub testBlockBound()
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
'Matrix3d ucs = ed.CurrentUserCoordinateSystem;
Dim clon As BlockReference = Nothing
doc.TransactionManager.EnableGraphicsFlush(True)
Try
Dim peo As New PromptEntityOptions(vbLf & "Select block: ")
peo.SetRejectMessage("Only a block instance !")
peo.AddAllowedClass(GetType(BlockReference), False)
Dim per As PromptEntityResult = ed.GetEntity(peo)
If per.Status <> PromptStatus.OK Then
Return
End If
Dim id As ObjectId = per.ObjectId
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim ent As Entity = CType(tr.GetObject(id, OpenMode.ForRead), Entity)
If ent Is Nothing Then
Return
End If
Dim bref As BlockReference = TryCast(ent, BlockReference)
If bref Is Nothing Then
Return
End If
clon = TryCast(bref.Clone(), BlockReference)
clon.Rotation = 0
clon.TransformBy(ed.CurrentUserCoordinateSystem)
tr.TransactionManager.QueueForGraphicsFlush()
Dim ext As Extents3d = clon.GeometryExtentsBestFit(ed.CurrentUserCoordinateSystem)
ext.TransformBy(ed.CurrentUserCoordinateSystem)
Dim pl As New Polyline(4)
Dim p1 As Point3d = ext.MinPoint.TransformBy(ed.CurrentUserCoordinateSystem)
Dim p3 As Point3d = ext.MaxPoint.TransformBy(ed.CurrentUserCoordinateSystem)
Dim p2 As Point3d = New Point3d(p3.X, p1.Y, p1.Z).TransformBy(ed.CurrentUserCoordinateSystem)
Dim p4 As Point3d = New Point3d(p1.X, p3.Y, p1.Z).TransformBy(ed.CurrentUserCoordinateSystem)
pl.AddVertexAt(0, New Point2d(p1.X, p1.Y), 0.0, 0.0, 0.0)
pl.AddVertexAt(1, New Point2d(p2.X, p2.Y), 0.0, 0.0, 0.0)
pl.AddVertexAt(2, New Point2d(p3.X, p3.Y), 0.0, 0.0, 0.0)
pl.AddVertexAt(3, New Point2d(p4.X, p4.Y), 0.0, 0.0, 0.0)
pl.Closed = True
pl.ColorIndex = 121
pl.TransformBy(ed.CurrentUserCoordinateSystem)
Dim rot As Matrix3d = Matrix3d.Rotation(bref.Rotation, bref.Normal.GetNormal(), bref.Position)
pl.TransformBy(rot)
Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
btr.AppendEntity(pl)
tr.AddNewlyCreatedDBObject(pl, True)
tr.TransactionManager.QueueForGraphicsFlush()
doc.TransactionManager.FlushGraphics()
tr.Commit()
End Using
Catch e As System.Exception
ed.WriteMessage(vbLf & "Error: {0}" & vbLf & "{1}", e.Message, e.StackTrace)
Finally
If Not clon.IsDisposed Then
clon.Dispose()
'optional
End If
End Try
End Sub