How to get Block's Layer name?

MGOMKD · ‎04-18-2012

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?

Hallex · ‎08-18-2012

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'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

Hallex · ‎08-18-2012

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'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

MGOMKD · ‎08-20-2012

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.

Hallex · ‎08-20-2012

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'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

MGOMKD · ‎08-20-2012

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".

Hallex · ‎08-20-2012

Sorry I've thought you told me about Polyline coordinates,

Glad you got it to work by yourself

Cheers 🙂

~'J'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

MGOMKD · ‎08-20-2012

Your help is always welcome, and I understant more and more the structure of AutoCAD.

Thanks a lot.

Hallex · ‎08-20-2012

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'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

MGOMKD · ‎08-22-2012

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!

Hallex · ‎08-23-2012

So, the issue is solved?

~'J'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

MGOMKD · ‎08-31-2012

Hi Hallex,

My source code is progressing!, I'll give it to you soon, but I have to chase every encounter bugs.

See you.

Community

How to get Block's Layer name?

How to get Block's Layer name?

How to get Block's Layer name?