Hi,
After searching for a long time on the web, does anyone know how to get the block's layer name?
I iterate through Blocks to get informations but i'm not able to code the source to obtain what i want?
Sample source taken from AutoCAD.NET site:
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction() '' Open the Block table for read Dim acBlkTbl As BlockTable = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead) '' Open the Block table record Model space for read Dim acBlkTblRec As BlockTableRecord acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForRead) '' Step through the Block table record For Each acObjId As ObjectId In acBlkTblRec acDoc.Editor.WriteMessage(vbLf & "DXF name: " & acObjId.ObjectClass().DxfName) acDoc.Editor.WriteMessage(vbLf & "ObjectID: " & acObjId.ToString()) acDoc.Editor.WriteMessage(vbLf & "Handle: " & acObjId.Handle.ToString()) acDoc.Editor.WriteMessage(vbLf) Next '' Dispose of the transaction End Using
Maybe use nested transaction to iterate through LayerTableId?
ideas?
Shortly, the Minpoint is means a lower left corner of bounding box of the object,
Maxpoint is opposite corner, kind of 2 corners of text frame
Here is a code to demonstate the mtext frame
<CommandMethod("FMM")> _ Public Shared Sub TextFrame() Dim doc As Document = Application.DocumentManager.MdiActiveDocument Dim ed As Editor = doc.Editor Dim db As Database = doc.Database Using docloc As DocumentLock = doc.LockDocument() Using tr As Transaction = db.TransactionManager.StartTransaction() Try Dim peo As PromptEntityOptions = New PromptEntityOptions(vbCr & "select mtext") peo.SetRejectMessage(vbCr & "selected object is not mtext") peo.AddAllowedClass(GetType(MText), True) Dim id As ObjectId = ed.GetEntity(peo).ObjectId Using mtext As MText = CType(tr.GetObject(id, OpenMode.ForWrite), MText) If mtext Is Nothing Then Return End If Using newtxt As MText = mtext.Clone() newtxt.Rotation = 0 newtxt.Width = mtext.ActualWidth newtxt.Height = mtext.ActualHeight Dim off As Double = newtxt.TextHeight * 0.35 Dim ext As Extents3d = newtxt.GeometricExtents Dim p1 As Point2d = New Point2d(ext.MinPoint.X - off, ext.MinPoint.Y - off) Dim p3 As Point2d = New Point2d(ext.MaxPoint.X + off, ext.MaxPoint.Y + off) Dim p2 As Point2d = New Point2d(p3.X, p1.Y) Dim p4 As Point2d = New Point2d(p1.X, p3.Y) Dim pline As New Polyline(4) pline.AddVertexAt(0, p1, 0, 0, 0) pline.AddVertexAt(1, p2, 0, 0, 0) pline.AddVertexAt(2, p3, 0, 0, 0) pline.AddVertexAt(3, p4, 0, 0, 0) pline.Closed = True pline.ColorIndex = 1 pline.ConstantWidth = newtxt.TextHeight * 0.13 pline.TransformBy(Matrix3d.Rotation(mtext.Rotation, ed.CurrentUserCoordinateSystem.CoordinateSystem3d.Zaxis, mtext.Location)) Dim bt As BlockTable = CType(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable) Dim btr As BlockTableRecord = CType(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord) btr.AppendEntity(pline) tr.AddNewlyCreatedDBObject(pline, True) End Using End Using tr.Commit() Catch ex As Autodesk.AutoCAD.Runtime.Exception ed.WriteMessage(vbCr & ex.Message & vbCr & ex.StackTrace) End Try End Using End Using End Sub
~'J'~
Here is example how to create the mtext (I'm using syntax fo A2010)
<CommandMethod("mtx")> _ Public Sub createMtext() Dim db As Database = doc.Database Dim tr As Transaction = db.TransactionManager.StartTransaction() Using tr Dim strvalue As String = "first text line\Psecond text line\Pthird text line" Dim pt As Point3d = New Point3d(10, 20, 0) Dim mtx As New MText mtx.Location = pt mtx.SetDatabaseDefaults() mtx.TextStyleId = db.Textstyle mtx.TextHeight = db.Dimtxt mtx.Width = 0 mtx.Contents = strvalue mtx.Attachment = AttachmentPoint.BottomCenter mtx.SetAttachmentMovingLocation(mtx.Attachment) Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord) btr.AppendEntity(mtx) tr.AddNewlyCreatedDBObject(mtx, True) mtx.Width = mtx.ActualWidth tr.Commit() End Using End Sub
~'J'~
Hi Hallex,
I worked on your source code about stocking Polylines coordinates.
'Insertion du texte' Dim MyVertices as Point3d
Dim Coord as Long
Dim X as Double
Dim Y as Double
Dim Z as Double
For Coord = 0 To MyPolyLine.NumberOfVertices - 1 MyVertices = MyPolyLine.GetPoint3dAt(Coord) X = X + MyVertices.Coordinate(0) Y = Y + MyVertices.Coordinate(1) Z = Z + MyVertices.Coordinate(2) Next X = X / MyPolyLine.NumberOfVertices Y = Y / MyPolyLine.NumberOfVertices Z = Z / MyPolyLine.NumberOfVertices
I use your function to obtain average X, Y and Z to insert MText in the middle of the piece!
Do you know how to obtain NumberOfVertices of "Region"?
You drive me on the right way! Thank you Hallex.
You have to calculate middle point using GetPoint3dAt method,
like this:
Dim cp as point3d= pline.GetPoint3dAt((pline.endparam-plne.startparam)/ 2)
then change mtext attachment like this:
mtx.location=cp
mtx.Attachment = AttachmentPoint.MiddleCenter etc...
~'J'~
Great source code Hallex, but GetPoint3d method doesn't appear with "Region".
I found a another way to get midpoint by using "Centroid", i used it when i wrote source code in VBA.
'Déclaration variable' Dim MyRegion As AcadRegion = TryCast(MyEnt, Entity) 'Insertion du texte'
acMText = New MText() X = MyRegion.Centroid(0) Y = MyRegion.Centroid(1) Z = MyRegion.Centroid(2)
With acMText acMText.SetDatabaseDefaults() acMText.Location = New Point3d(X, Y, Z) acMText.Attachment = AttachmentPoint.MiddleCenter acMText.TextHeight = acHeightText acMText.Contents = i End With
acBlkTblRec.AppendEntity(acMText) acTrans.AddNewlyCreatedDBObject(acMText, True)
Centroid only works with "Region".
Sorry I've thought you told me about Polyline coordinates,
Glad you got it to work by yourself
Cheers 🙂
~'J'~
I used same way but a bit different one, see if thisis working for you
'' Imports System.Reflection '' Imports Autodesk.AutoCAD.Interop.Common ''------------------------------------ WH ------------------------------'' <CommandMethod("LabelArea", "lar", CommandFlags.UsePickSet Or CommandFlags.Redraw)> _ Public Shared Sub CreateRegionFromPline() Dim doc As Document = Application.DocumentManager.MdiActiveDocument Dim db As Database = doc.Database Dim ed As Editor = doc.Editor Try Using tr As Transaction = db.TransactionManager.StartTransaction() Dim btr As BlockTableRecord = TryCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord) Dim peo As PromptEntityOptions = New PromptEntityOptions(vbLf + "Select Polyline: ") peo.SetRejectMessage(vbLf + "You have to select closed Polyline!") peo.AddAllowedClass(GetType(Polyline), False) Dim res As PromptEntityResult = ed.GetEntity(peo) If res.Status <> PromptStatus.OK Then Return Dim ent As Entity = DirectCast(tr.GetObject(res.ObjectId, OpenMode.ForRead), Entity) Dim pline As Polyline = TryCast(ent, Polyline) If Not pline.Closed Then Return Dim copy As Polyline = pline.Clone If Not copy.IsWriteEnabled Then copy.UpgradeOpen() btr.AppendEntity(copy) tr.AddNewlyCreatedDBObject(copy, True) Dim dbcoll As New DBObjectCollection() dbcoll.Add(copy) Dim regColl As New DBObjectCollection() regColl = Region.CreateFromCurves(dbcoll) Dim reg As Region = DirectCast(regColl(0), Region) btr.AppendEntity(reg) tr.AddNewlyCreatedDBObject(reg, True) tr.TransactionManager.QueueForGraphicsFlush() Dim obj As Object = reg.AcadObject Dim dbl() As Double = TryCast(obj.GetType().InvokeMember("Centroid", BindingFlags.GetProperty, Nothing, obj, Nothing), Double()) Dim cp As Point3d = New Point3d(dbl(0), dbl(1), pline.Elevation) ed.WriteMessage(vbLf + "{0}" + "{1}", cp.X, cp.Y) Dim mtx As New MText mtx.Location = cp mtx.SetDatabaseDefaults() mtx.TextStyleId = db.Textstyle mtx.TextHeight = db.Dimtxt mtx.Width = 0 mtx.Contents = String.Format("{0:f3}", pline.Area) mtx.Attachment = AttachmentPoint.MiddleCenter mtx.SetAttachmentMovingLocation(mtx.Attachment) btr.AppendEntity(mtx) tr.AddNewlyCreatedDBObject(mtx, True) If copy IsNot Nothing Then copy.Erase() End If If reg IsNot Nothing Then reg.Erase() End If tr.Commit() End Using Catch ex As Autodesk.AutoCAD.Runtime.Exception ed.WriteMessage((vbLf + ex.Message & vbLf) + ex.StackTrace) Finally End Try End Sub
~'J'~
Hi Hallex,
Thank you for your code, I really have to work on it! Not quietly but surely!
Another way to obtain Region.Centroid.
Dim MyRegion As AcadRegion = MyEnt.AcadObject 'Insertion du texte' acMText = New MText() X = MyRegion.Centroid(0) Y = MyRegion.Centroid(1) Z = 0 With acMText acMText.SetDatabaseDefaults() acMText.Location = New Point3d(X, Y, Z) acMText.Attachment = AttachmentPoint.MiddleCenter acMText.TextHeight = acHeightText acMText.Contents = i End With acBlkTblRec.AppendEntity(acMText) acTrans.AddNewlyCreatedDBObject(acMText, True)
Coding is so fascinating!
Hi Hallex,
My source code is progressing!, I'll give it to you soon, but I have to chase every encounter bugs.
See you.