Topic: GstarCAD Api : WblockCloneObjects

[neyton]

Hi,

I have a problem with this code:

Code: [Select]

<CommandMethod("teste")>
    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


Run it, select attached DWT.

It should create a new layout in the current drawing and insert it a copy of the existing layout in the design "MODELOS.dwt"

But it does not recognize the mapping to a block that is in the original layout

Something is missing?

[Bryco]

Not sure if you are first adding the template block to the blocks, then adding it to paperspace (that has worked for me).
For new drawings I  File.Copy(sTemplate,sPath);  copy the template to the new folder w/ the new name

[neyton]

The workflow is as follows:

1) in model space have a subdivision of lots
2) in each layout will be a leaf for each lots
3) call a command, asking for choosing a DWT that contains the layout model
4) then this command creates the various layouts using the layout model. This model must contain a block with attributes and a viewport.
5) The command centers the viewport in the centroid of the lot and fills the attributes of the block

This flow works well in AutoCAD with the code shown.

The problem is in GstarCAD, to do the "WblockCloneObjects" apparently is not cloning everything, including giving fatal error and closes the GstarCAD

[ChrisCarlson]

If it works as expected in AutoCAD my suggestion is to contact support@gstarcad.net

[neyton]

I've done this