GstarCAD Api ： WblockCloneObjects

    Public Sub teste()
        Dim ofd As New OpenFileDialog
        If Not ofd.ShowDialog Then Exit Sub
        Dim layoutTemplate As String = "MODELO_A4"
        Dim layoutName As String = "NOVO_LAYOUT"
        Dim handleBlocoCarimbo As String = "D66"
        Dim handleMainViewPort As String = "C0E"
        Dim handleLayoutViewPort As String = "C13"
        Dim doc = ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Using tr = doc.TransactionManager.StartTransaction
            Using dbOrig As New Database(False, True)
                dbOrig.ReadDwgFile(ofd.FileName, FileShare.Read, True, "")
                'Make the original database the working database
                HostApplicationServices.WorkingDatabase = dbOrig
                Using trOrig As Transaction = dbOrig.TransactionManager.StartTransaction()
                    ' Get the dictionary of the original database
                    Dim lytDict As DBDictionary = trOrig.GetObject(dbOrig.LayoutDictionaryId, ForRead)
                    'Get the layout in the original database
                    Dim lytMgr As LayoutManager = LayoutManager.Current()
                    Dim layoutId As ObjectId = lytMgr.GetLayoutId(layoutTemplate)
                    Dim layout As Layout = trOrig.GetObject(layoutId, ForRead)
                    'Get the block table record of the existing layout
                    Dim blkTableRec As BlockTableRecord = trOrig.GetObject(layout.BlockTableRecordId, ForRead)
                    'Get the object ids of the objects in the existing block table record
                    Dim objIdCol As New ObjectIdCollection()
                    For Each objId As ObjectId In blkTableRec
                        objIdCol.Add(objId)
                    Next
                    'return to original WorkingDatabase
                    HostApplicationServices.WorkingDatabase = doc.Database
                    ' Clone the objects to the new layout
                    Dim newLytMgr As LayoutManager = LayoutManager.Current()
                    If newLytMgr.GetLayoutId(layoutName).IsValid Then
                        newLytMgr.DeleteLayout(layoutName)
                    End If
                    Dim newLayoutId As ObjectId = newLytMgr.CreateLayout(layoutName)
                    Dim newLayout As Layout = newLayoutId.GetObject(OpenMode.ForWrite)
                    newLayout.CopyFrom(layout)
                    Dim idMap As New IdMapping()
                    doc.Database.WblockCloneObjects(objIdCol,
                                              newLayout.BlockTableRecordId,
                                              idMap,
                                              DuplicateRecordCloning.Ignore,
                                              False)
                    'define block attributes
                    Dim bid As ObjectId = HandleToObjectID(dbOrig, handleBlocoCarimbo)
                    Dim bref As BlockReference = idMap(bid).Value.GetObject(ForWrite)
                    If bref Is Nothing Then
                        MsgBox("error, bref is nothing")
                        Exit Sub
                    End If
                    For Each attid As ObjectId In bref.AttributeCollection
                        Dim attref As AttributeReference = attid.GetObject(ForWrite)
                        attref.TextString = "teste"
                    Next
                    'define viewport center
                    Dim vp As Viewport = idMap(HandleToObjectID(dbOrig, handleLayoutViewPort)).Value.GetObject(ForWrite)
                    vp.ViewCenter = New Point2d(0, 0)
                    vp.ViewTarget = Point3d.Origin 'para o viewcenter funcionar
                    'zoom extents no bloco do carimbo
                    vp = idMap(HandleToObjectID(dbOrig, handleMainViewPort)).Value.GetObject(ForWrite)
                    With bref.GeometricExtents
                        vp.ViewCenter = New Point2d((.MaxPoint.X + .MinPoint.X) / 2, (.MaxPoint.Y + .MinPoint.Y) / 2)
                        vp.ViewTarget = Point3d.Origin 'para o viewcenter funcionar
                        vp.ViewHeight = .MaxPoint.Y - .MinPoint.Y
                    End With
                End Using 'trOrig
            End Using 'dbOrig  
            If layoutName IsNot Nothing Then
                LayoutManager.Current.CurrentLayout = layoutName
                LayoutManager.Current.CurrentLayout = "Model"
            End If
        End Using
    End Sub
 Public Function HandleToObjectID(db As Database, ByVal h As String) As ObjectId
        Try
            Dim num As Long = Long.Parse(h, Globalization.NumberStyles.HexNumber)
            Dim id As ObjectId = db.GetObjectId(False, New Handle(num), 0)
            If id.IsErased Then Return ObjectId.Null
            Return id
        Catch
            Return ObjectId.Null
        End Try
    End Function