.NET
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Change attribute properties inside a multileader

3 REPLIES 3
Reply
Message 1 of 4
andred
1523 Views, 3 Replies

Change attribute properties inside a multileader

Hi,

 

Is anybody have a sample code to change attributes properties when the block is inside a multileader?

 

Regards

 

André

 

3 REPLIES 3
Message 2 of 4
Hallex
in reply to: andred

Hi André, Take a look at this example probably it will helps

 

http://www.acadnetwork.com/topic-210.msg381.html#msg381

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 3 of 4
Hallex
in reply to: Hallex

Here is VB.NET code

        ' Make sure if block "LEADERBLOCK" is exist
        ' and have 2 attributes "NUMBER" & "DESCRIPTION"
        ' Or change all above to your needs
        ' based on article from
        ' http://adndevblog.typepad.com/autocad/2012/05/how-to-create-mleader-objects-in-net.html
        <CommandMethod("MBA")> _
        Public Shared Sub netBlockMLeader()

            Dim doc As Document = Application.DocumentManager.MdiActiveDocument

            Dim db As Database = doc.Database

            Dim ed As Editor = doc.Editor

            Using tr As Transaction = db.TransactionManager.StartTransaction()

                Dim bt As BlockTable = TryCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)

                Dim btr As BlockTableRecord = TryCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                ' Make sure if this block exist
                If Not bt.Has("LEADERBLOCK") Then

                    ed.WriteMessage(vbLf & "You need to define a ""LEADERBLOCK"" first...")

                    Return

                End If
                Dim ppo As New PromptPointOptions(vbLf & "Pick arrow point >>")

                Dim ptres As PromptPointResult
                ptres = ed.GetPoint(ppo)
                If ptres.Status <> PromptStatus.OK Then
                    Return
                End If

                Dim arrPt As Point3d = ptres.Value

                ppo = New PromptPointOptions(vbLf & "Pick leader text point >>")
                ppo.UseBasePoint = True
                ppo.BasePoint = arrPt
                ppo.UseDashedLine = True
                ptres = ed.GetPoint(ppo)
                If ptres.Status <> PromptStatus.OK Then
                    Return
                End If

                Dim textPt As Point3d = ptres.Value

                Dim firsttxt As String

                Dim pso As New PromptStringOptions(vbLf & "Enter text for attribute NUMBER: ")

                pso.AllowSpaces = True

                Dim res As PromptResult

                res = ed.GetString(pso)

                If res.Status <> PromptStatus.OK Then

                    Return

                End If

                firsttxt = res.StringResult

                Dim sndtxt As String

                pso.Message = vbLf & "Enter text for attribute DESCRIPTION: "

                res = ed.GetString(pso)

                If res.Status <> PromptStatus.OK Then

                    Return

                End If

                sndtxt = res.StringResult

                Dim mlead As New MLeader()

                mlead.SetDatabaseDefaults()

                mlead.ContentType = ContentType.BlockContent
                ' Get ObjectId of mleader block
                mlead.BlockContentId = bt("LEADERBLOCK")

                mlead.BlockPosition = textPt

                Dim idx As Integer = mlead.AddLeaderLine(arrPt)

                mlead.AddFirstVertex(0, arrPt)

                'Handle Block Attributes

                Dim num As Integer = 0

                Dim leadblk As BlockTableRecord = TryCast(tr.GetObject(mlead.BlockContentId, OpenMode.ForRead), BlockTableRecord)

                'Doesn't take in consideration oLeader.BlockRotation

                Dim mat As Matrix3d = Matrix3d.Displacement(mlead.BlockPosition.GetAsVector())

                For Each attId As ObjectId In leadblk

                    Dim attdef As AttributeDefinition = TryCast(tr.GetObject(attId, OpenMode.ForRead), AttributeDefinition)

                    If attdef IsNot Nothing Then

                        Dim tag As String = attdef.Tag.ToUpper

                        Dim attref As New AttributeReference()
                        ''---------------------------------------------''
                        Select Case tag
                            Case "NUMBER"
                                attref.SetAttributeFromBlock(attdef, mat)

                                attref.Position = attdef.Position.TransformBy(mat)

                                attref.TextString = firsttxt

                                mlead.SetBlockAttribute(attId, attref)
                            Case "DESCRIPTION"
                                attref.SetAttributeFromBlock(attdef, mat)

                                attref.Position = attdef.Position.TransformBy(mat)

                                attref.TextString = sndtxt

                                mlead.SetBlockAttribute(attId, attref)

                                'Case ETC ETC.....

                        End Select

                    End If
                Next

                btr.AppendEntity(mlead)

                tr.AddNewlyCreatedDBObject(mlead, True)

                tr.Commit()
            End Using

        End Sub

 

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 4 of 4
andred
in reply to: Hallex

Thank you, I will take a look at your sample code in the next days and give you a feddback.

 

Regards,

 

André

 

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk DevCon in Munich May 28-29th


Autodesk Design & Make Report

”Boost