.NET

Reply
Valued Contributor
MRiemenCAD
Posts: 65
Registered: ‎03-31-2003
Message 1 of 7 (1,615 Views)
Accepted Solution

Add entities to new block

1615 Views, 6 Replies
01-28-2011 08:35 AM

Working with making blocks from existing entities in a file. I've run into problems with iterating through the entities within a selection set and writing them to my new blocktablerecord. How do I take those items from my selection set and add them to this new block? All thoughts and help are appreciated. 

Yup.  The ObjectIdCollection constructor can take an ObjectId array as an argument, which is what SelectionSet.GetObjectIds() provides.

 

Put another way...

 

Dim ids as ObjectIdCollection = New ObjectIdCollection(sset.GetObjectIds)

Something like this

Just a hint starting the new thread you will be able to get a much more explanations

because of hiding your question at the end of thread

 

Imports System
Imports System.Text
Imports acApp = Autodesk.AutoCAD.ApplicationServices.Application
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Public Class TesterCommands
<CommandMethod("bobo", CommandFlags.UsePickSet)> _
Public Sub MakeBlockFromSelection()
Dim doc As Document = acApp.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Using docloc As DocumentLock = doc.LockDocument
Using tr As Transaction = db.TransactionManager.StartTransaction
Try
Dim pso As New PromptSelectionOptions()
pso.MessageForRemoval = vbLf & " >> Nothing selected...."
pso.MessageForAdding = vbLf & " >> Select objects >> "
pso.AllowDuplicates = False
pso.SingleOnly = True
Dim res As PromptSelectionResult = ed.GetSelection(pso)
If res.Status <> PromptStatus.OK Then
Return
End If
Dim ids As ObjectId() = res.Value.GetObjectIds()
If ids.Length = 0 Then
Return
End If
Dim ppo As New PromptPointOptions(vbLf & "Pick insertion point for newly created block >>")
Dim pres As PromptPointResult = ed.GetPoint(ppo)
If pres.Status <> PromptStatus.OK Then
Return
End If
Dim ip As Point3d = pres.Value
Dim bt As BlockTable = DirectCast(db.BlockTableId.GetObject(OpenMode.ForWrite), BlockTable)
Dim newname As String = "MyCoolBlock"
If bt.Has(newname) Then
ed.WriteMessage(vbLf & "Block ""{0}"" already exist", newname)
Return
End If
Dim bids As New ObjectIdCollection()
For Each eid As ObjectId In ids
bids.Add(eid)
Next
acApp.SetSystemVariable("clayer", "0")
acApp.SetSystemVariable("cecolor", "bylayer")
Dim nbtr As New BlockTableRecord()
bt.Add(nbtr)
nbtr.Name = newname
nbtr.Origin = ip
nbtr.BlockScaling = BlockScaling.Uniform
nbtr.Explodable = True
tr.AddNewlyCreatedDBObject(nbtr, True)
Dim map As New IdMapping()
db.DeepCloneObjects(bids, nbtr.ObjectId, map, False)
Dim coll As New ObjectIdCollection()
For Each pair As IdPair In map
If pair.IsPrimary Then
Dim ent As Entity = DirectCast(tr.GetObject(pair.Value, OpenMode.ForWrite), Entity)
If ent IsNot Nothing Then
ent.Layer = "0"
ent.ColorIndex = 0
If (TypeOf (ent) Is AttributeDefinition) Then
Dim att As AttributeDefinition = DirectCast(ent, AttributeDefinition)
att.LockPositionInBlock = True
End If
'<-- color byblock
coll.Add(ent.ObjectId)
End If
End If
Next
nbtr.AssumeOwnershipOf(coll)
tr.Commit()
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage(vbLf + ex.Message + vbLf + ex.StackTrace)
End Try
End Using
End Using
End Sub
End Class

 

 

~'J'~

 

 

 

 

 

Active Contributor
dan.glassman
Posts: 43
Registered: ‎09-23-2008
Message 2 of 7 (1,609 Views)

Re: Add entities to new block

01-28-2011 09:04 AM in reply to: MRiemenCAD

You can:

 

  • Manually create the new BlockTableRecord and BlockTable.Add() it, then
  • Database.DeepCloneObjects() into your new BlockTableRecord
or:
  • Database.WBlock(ObjectIdCollection,Point3d) to create a new, temporary database containing your objects, then
  • Database.Insert(string, Database, bool) to create your new BlockTableRecord
or (if you don't mind deleting that the existing entities are _moved_ to the new BlockTableRecord rather than copied):
  • Manually create the new BlockTableRecord and BlockTable.Add() it, then
  • BlockTableRecord.AssumeOwnershipOf()

 

Valued Contributor
MRiemenCAD
Posts: 65
Registered: ‎03-31-2003
Message 3 of 7 (1,603 Views)

Re: Add entities to new block

01-28-2011 09:16 AM in reply to: dan.glassman

Thanks,

 

I like the "AssumeOwnershipOf" route that you suggest. When I use this on the selection set I'm told that the set  cannot be converted into and ObjectIDCollection. May this I'm missing a simple step in working with selection sets. Is there an easy way to take the objects from the selection set, create a suitable IDCollection and then pass that collection to the "AssumeOwnershipOf" method?

Matt

 

Active Contributor
dan.glassman
Posts: 43
Registered: ‎09-23-2008
Message 4 of 7 (1,600 Views)

Re: Add entities to new block

01-28-2011 09:21 AM in reply to: MRiemenCAD

Yup.  The ObjectIdCollection constructor can take an ObjectId array as an argument, which is what SelectionSet.GetObjectIds() provides.

 

Put another way...

 

Dim ids as ObjectIdCollection = New ObjectIdCollection(sset.GetObjectIds)

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 5 of 7 (1,597 Views)

Re: Add entities to new block

01-28-2011 09:24 AM in reply to: MRiemenCAD

Something like this

Just a hint starting the new thread you will be able to get a much more explanations

because of hiding your question at the end of thread

 

Imports System
Imports System.Text
Imports acApp = Autodesk.AutoCAD.ApplicationServices.Application
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry



Public Class TesterCommands
    <CommandMethod("bobo", CommandFlags.UsePickSet)> _
    Public Sub MakeBlockFromSelection()

        Dim doc As Document = acApp.DocumentManager.MdiActiveDocument

        Dim db As Database = doc.Database

        Dim ed As Editor = doc.Editor

        Using docloc As DocumentLock = doc.LockDocument

            Using tr As Transaction = db.TransactionManager.StartTransaction

                Try

                    Dim pso As New PromptSelectionOptions()

                    pso.MessageForRemoval = vbLf & " >>  Nothing selected...."

                    pso.MessageForAdding = vbLf & "  >>  Select objects >> "

                    pso.AllowDuplicates = False

                    pso.SingleOnly = True

                    Dim res As PromptSelectionResult = ed.GetSelection(pso)

                    If res.Status <> PromptStatus.OK Then
                        Return
                    End If

                    Dim ids As ObjectId() = res.Value.GetObjectIds()

                    If ids.Length = 0 Then
                        Return
                    End If

                    Dim ppo As New PromptPointOptions(vbLf & "Pick insertion point for newly created block >>")

                    Dim pres As PromptPointResult = ed.GetPoint(ppo)

                    If pres.Status <> PromptStatus.OK Then

                        Return
                    End If

                    Dim ip As Point3d = pres.Value

                    Dim bt As BlockTable = DirectCast(db.BlockTableId.GetObject(OpenMode.ForWrite), BlockTable)


                    Dim newname As String = "MyCoolBlock"

                    If bt.Has(newname) Then
                        ed.WriteMessage(vbLf & "Block ""{0}"" already exist", newname)

                        Return
                    End If

                    Dim bids As New ObjectIdCollection()

                    For Each eid As ObjectId In ids

                        bids.Add(eid)
                    Next

                    acApp.SetSystemVariable("clayer", "0")

                    acApp.SetSystemVariable("cecolor", "bylayer")

                    Dim nbtr As New BlockTableRecord()

                    bt.Add(nbtr)

                    nbtr.Name = newname

                    nbtr.Origin = ip


                    nbtr.BlockScaling = BlockScaling.Uniform

                    nbtr.Explodable = True

                    tr.AddNewlyCreatedDBObject(nbtr, True)


                    Dim map As New IdMapping()

                    db.DeepCloneObjects(bids, nbtr.ObjectId, map, False)

                    Dim coll As New ObjectIdCollection()

                    For Each pair As IdPair In map
                        If pair.IsPrimary Then
                            Dim ent As Entity = DirectCast(tr.GetObject(pair.Value, OpenMode.ForWrite), Entity)
                            If ent IsNot Nothing Then
                                ent.Layer = "0"

                                ent.ColorIndex = 0
                                If (TypeOf (ent) Is AttributeDefinition) Then
                                    Dim att As AttributeDefinition = DirectCast(ent, AttributeDefinition)
                                    att.LockPositionInBlock = True
                                End If
                                '<-- color byblock
                                coll.Add(ent.ObjectId)
                            End If
                        End If
                    Next

                    nbtr.AssumeOwnershipOf(coll)


                    tr.Commit()
                Catch ex As Autodesk.AutoCAD.Runtime.Exception

                    ed.WriteMessage(vbLf + ex.Message + vbLf + ex.StackTrace)

                End Try
            End Using
        End Using

    End Sub

End Class

 

 

~'J'~

 

 

 

 

 

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Valued Contributor
MRiemenCAD
Posts: 65
Registered: ‎03-31-2003
Message 6 of 7 (1,594 Views)

Re: Add entities to new block

01-28-2011 09:42 AM in reply to: Hallex

Thanks for your post. I thought that your previous comment to the original string was close to the sollution i was after so i tried targetting my question. :smileyhappy:

 

thanks for you reply. It worked great. I'll study through it to see what I missed on my own.

 

regards,

 

matt

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 7 of 7 (1,573 Views)

Re: Add entities to new block

01-28-2011 01:00 PM in reply to: MRiemenCAD

You're welcome

 Cheers :smileyhappy:

 

Oleg

 

~'J'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.