.NET

Reply
Contributor
karea
Posts: 25
Registered: ‎01-27-2011
Message 1 of 4 (226 Views)
Accepted Solution

Change block layer after insertio

226 Views, 3 Replies
07-31-2013 08:36 AM

Hi:

I've inserted a block into my drawing with this code:

....

Dim tmpDb As New Database(False, True)
        tmpDb.ReadDwgFile(nombrebloque, System.IO.FileShare.Read, True, "")
        
        Dim Transform As Matrix3d = Matrix3d _
                                    .Scaling(scale, Point3d.Origin) _
                                    .PreMultiplyBy(Matrix3d.Displacement(DispacementVector)) _
                                    .PreMultiplyBy(myed.CurrentUserCoordinateSystem)
        mydb.Insert(Transform, tmpDb, True)
....

 

and I would like to change some properties (layer, color,...) of the entities. (without modify the original block)

 

How can I access to these entities?

thanks..

Try this code, just change the path of your source drawing in the code

(assume your drawing is contains just separate objects like attribues, lines,and other

entities but not complete block itself)

 <CommandMethod("nombreblk", CommandFlags.Session And CommandFlags.Redraw)> _
Public Sub testExternalInsert()
Try
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim myed As Editor = doc.Editor
Dim mydb As Database = doc.Database
Dim sourceFileName As String = "C:\Test\NombreBloque.dwg" '<-- source file path
Dim blkId As ObjectId = ObjectId.Null
Dim nombrebloque As String = SymbolUtilityServices.GetBlockNameFromInsertPathName(sourceFileName)
Using docloc As DocumentLock = doc.LockDocument
Using tr As Transaction = doc.TransactionManager.StartTransaction
Dim blkTbl As BlockTable = tr.GetObject(mydb.BlockTableId, OpenMode.ForRead, False, True)
If blkTbl.Has(nombrebloque) Then
Application.ShowAlertDialog("Block " + nombrebloque + " already exist. Exit.")
Return
End If
Dim myBtr As BlockTableRecord = TryCast(tr.GetObject(mydb.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Using tmpDb As New Database(True, True)
tmpDb.ReadDwgFile(sourceFileName, System.IO.FileShare.Read, False, "")
blkId = mydb.Insert(nombrebloque, tmpDb, True)
tmpDb.CloseInput(True)
End Using
If Not blkTbl.Has(nombrebloque) Then
Application.ShowAlertDialog("Problem with import block. Exit")
Return
End If
Dim btr As BlockTableRecord = DirectCast(tr.GetObject(mydb.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim bref As BlockReference = New BlockReference(Point3d.Origin, blkId)
'change some properties:
Dim scale As Double = 1.0
Dim scl As Scale3d = New Scale3d(scale)
bref.ScaleFactors = scl
bref.Rotation = Math.PI / 4
bref.LayerId = mydb.Clayer
bref.Color = mydb.Cecolor
myBtr.AppendEntity(bref)
tr.AddNewlyCreatedDBObject(bref, True)
Dim blkRec As BlockTableRecord = DirectCast(tr.GetObject(blkTbl(nombrebloque), OpenMode.ForRead, False, True), BlockTableRecord)
If blkRec.HasAttributeDefinitions Then
Dim attColl As AttributeCollection = bref.AttributeCollection
For Each attId As ObjectId In blkRec
Dim ent As Entity = DirectCast(tr.GetObject(attId, OpenMode.ForRead), Entity)
If TypeOf ent Is AttributeDefinition Then
Dim attDef As AttributeDefinition = DirectCast(ent, AttributeDefinition)
Dim attRef As New AttributeReference()
attRef.SetAttributeFromBlock(attDef, bref.BlockTransform)
attRef.Tag = attDef.Tag
attRef.TextString = attDef.TextString
Dim id As ObjectId = attColl.AppendAttribute(attRef)
attRef.AdjustAlignment(mydb)
tr.AddNewlyCreatedDBObject(attRef, True)
End If
Next
End If
tr.Commit()
End Using
End Using
Catch ex As System.Exception
Application.ShowAlertDialog(ex.Message.ToString() & vbLf & ex.StackTrace)
Finally
Application.ShowAlertDialog("See result.")
End Try
End Sub

 

 

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

Re: Change block layer after insertio

07-31-2013 11:02 AM in reply to: karea

Try this code, just change the path of your source drawing in the code

(assume your drawing is contains just separate objects like attribues, lines,and other

entities but not complete block itself)

        <CommandMethod("nombreblk", CommandFlags.Session And CommandFlags.Redraw)> _
        Public Sub testExternalInsert()
            Try
                Dim doc As Document = Application.DocumentManager.MdiActiveDocument
                Dim myed As Editor = doc.Editor
                Dim mydb As Database = doc.Database
                Dim sourceFileName As String = "C:\Test\NombreBloque.dwg"	'<-- source file path
                Dim blkId As ObjectId = ObjectId.Null
                Dim nombrebloque As String = SymbolUtilityServices.GetBlockNameFromInsertPathName(sourceFileName)
                
                Using docloc As DocumentLock = doc.LockDocument
                    Using tr As Transaction = doc.TransactionManager.StartTransaction
                        Dim blkTbl As BlockTable = tr.GetObject(mydb.BlockTableId, OpenMode.ForRead, False, True)
                        If blkTbl.Has(nombrebloque) Then
                            Application.ShowAlertDialog("Block " + nombrebloque + " already exist. Exit.")
                            Return
                        End If
                        Dim myBtr As BlockTableRecord = TryCast(tr.GetObject(mydb.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                 
                        Using tmpDb As New Database(True, True)
                            tmpDb.ReadDwgFile(sourceFileName, System.IO.FileShare.Read, False, "")

                            blkId = mydb.Insert(nombrebloque, tmpDb, True)

                            tmpDb.CloseInput(True)

                        End Using

                        If Not blkTbl.Has(nombrebloque) Then
                            Application.ShowAlertDialog("Problem with import block. Exit")
                            Return
                        End If
                        Dim btr As BlockTableRecord = DirectCast(tr.GetObject(mydb.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                        Dim bref As BlockReference = New BlockReference(Point3d.Origin, blkId)
                        'change some properties:
                        Dim scale As Double = 1.0
                        Dim scl As Scale3d = New Scale3d(scale)
                        bref.ScaleFactors = scl
                        bref.Rotation = Math.PI / 4
                        bref.LayerId = mydb.Clayer
                        bref.Color = mydb.Cecolor
                     
                        myBtr.AppendEntity(bref)
                        tr.AddNewlyCreatedDBObject(bref, True)

                        Dim blkRec As BlockTableRecord = DirectCast(tr.GetObject(blkTbl(nombrebloque), OpenMode.ForRead, False, True), BlockTableRecord)

                        If blkRec.HasAttributeDefinitions Then

                            Dim attColl As AttributeCollection = bref.AttributeCollection

                            For Each attId As ObjectId In blkRec
                                Dim ent As Entity = DirectCast(tr.GetObject(attId, OpenMode.ForRead), Entity)
                                If TypeOf ent Is AttributeDefinition Then
                                    Dim attDef As AttributeDefinition = DirectCast(ent, AttributeDefinition)
                                    Dim attRef As New AttributeReference()
                                    attRef.SetAttributeFromBlock(attDef, bref.BlockTransform)
                                    attRef.Tag = attDef.Tag
                                    attRef.TextString = attDef.TextString
                                    Dim id As ObjectId = attColl.AppendAttribute(attRef)
                                    attRef.AdjustAlignment(mydb)
                                    tr.AddNewlyCreatedDBObject(attRef, True)
                           
                                End If
                            Next

                        End If
                        tr.Commit()

                    End Using
                End Using

            Catch ex As System.Exception
                Application.ShowAlertDialog(ex.Message.ToString() & vbLf & ex.StackTrace)

            Finally
                Application.ShowAlertDialog("See result.")
            End Try
        End Sub

 

 

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Contributor
karea
Posts: 25
Registered: ‎01-27-2011
Message 3 of 4 (182 Views)

Re: Change block layer after insertio

08-01-2013 05:28 AM in reply to: Hallex
great! it runs!

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

Re: Change block layer after insertio

08-01-2013 11:57 AM in reply to: karea

Im happy to help

Cheers :smileyhappy:

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Announcements
Do you have 60 seconds to spare? The Autodesk Community Team is revamping our site ranking system and we want your feedback! Please click here to launch the 5 question survey. As always your input is greatly appreciated.