Topic: How to immitate wblock command

[TJK44]

I believe if you use WblockCloneObjects() the block maintains its current insertion point, rotation, etc correct?

[TheMaster]

I believe if you use WblockCloneObjects() the block maintains its current insertion point, rotation, etc correct?

I'll assume that you actually mean an insertion of the block (BlockReference), not the block definition (BlockTableRecord), and in that case, it is the block insertion that you have to clone, not the definition.

When you clone a block insertion, all dependents (most notably the block definition) are also cloned.

So you would pass WblockCloneObjects() just the BlockReference (inserted into model space, using whatever parameters you want), and that should give you the insertion and its attributes in the destination drawing.

[TJK44]

Sorry, have been really busy working on our ERP system this week. Hopefully will get a chance to look at this before the week is over. I will get back to you at that time. Thanks.

[TJK44]

Finally have some time to visit this again. I have been playing with this for the past hour and nowhere still. I have attached 2 files if someone wants to see what I happening. The First file, Mirror Fix Org.dwg is the one to run the code against. Open the Mirror Fix Check File, select everything and do a copy base point 0,0,0 and then go into the newly generated file and paste to original coordinates. The white should fall directly on top of what is in the generated file.

Here is the code I am playing with (sorry it is very messy at this stage)

Code: [Select]

        <CommandMethod("TEDCreateMasterDWG")> _
        Public Sub MasterTest()
            Dim document As Document = Application.DocumentManager.MdiActiveDocument
            document.SendStringToExecute("_.ucs ", True, False, False)
            document.SendStringToExecute("top ", True, False, False)
            document.SendStringToExecute("_qsave ", True, False, False)
            Dim editor As Editor = document.Editor
            Dim database As Database = document.Database

            Dim fName2 As String = document.Name
            If fName2 = "" Then
                Exit Sub
            End If
            Dim curdir2 As String = Path.GetDirectoryName(fName2)
            Dim frm1 As New frmBlockCreator
            Dim strFileName As String
            frm1.SaveFileDialog1.InitialDirectory = curdir2
            frm1.SaveFileDialog1.Title = "Select a location to save the master file."
            frm1.SaveFileDialog1.Filter = "Drawing Files|*.dwg"
            frm1.SaveFileDialog1.AddExtension = True

            If frm1.SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
                strFileName = frm1.SaveFileDialog1.FileName
            Else
                Exit Sub
            End If
            Dim db As Database = New Database(True, False)
            Try
                Using trans2 As Transaction = db.TransactionManager.StartTransaction()
                    db.SaveAs(strFileName, DwgVersion.Newest)
                End Using
            Catch ex As System.Exception
                MsgBox(ex.Message)
            End Try
            db.Dispose()
            Dim oidc As New ObjectIdCollection()
            Try
                Using trans As Transaction = database.TransactionManager.StartTransaction()
                    Dim btr As BlockTable = DirectCast(trans.GetObject(database.BlockTableId, OpenMode.ForRead), BlockTable)
                    Dim btrMs As BlockTableRecord = TryCast(btr(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead), BlockTableRecord)
                    'go through each object in the block table record
                    For Each entID As ObjectId In btrMs
                        'create variable used to determine is it is a block reference
                        Dim ent As Entity = trans.GetObject(entID, OpenMode.ForRead, False)
                        'if it is a block then perform code below
                        If TypeOf ent Is BlockReference Then
                            Dim blkRef As BlockReference = TryCast(trans.GetObject(entID, OpenMode.ForRead, False), BlockReference)

                            Dim bid As ObjectId = blkRef.BlockTableRecord
                            Dim blocktr As BlockTableRecord = DirectCast(trans.GetObject(bid, OpenMode.ForRead), BlockTableRecord)

                            If blocktr.IsFromExternalReference Then
                                Dim btrpathname As String = blocktr.PathName.ToString
                                Dim strFileDir As String = Path.GetFileNameWithoutExtension(strFileName)
                                Dim strSaveDir As String = Path.GetDirectoryName(strFileName)
                                Dim strBlockName As String = blkRef.Name
                                Dim strPartFile As String = strSaveDir & "\" & strFileDir & " - Parts\" & strBlockName & ".dwg"
                                'If Mid(btrpathname, 1, 2) = "S:" Then
                                Dim db2 As Database = New Database(True, False)
                                'read newly created dwg file
                                db2.ReadDwgFile(strFileName, FileShare.ReadWrite, False, "")
                                Using trx As Transaction = db2.TransactionManager.StartTransaction()
                                    Dim xrefBt As BlockTable = trx.GetObject(db2.BlockTableId, OpenMode.ForWrite)
                                    Dim btrMs2 As BlockTableRecord = trx.GetObject(xrefBt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)

                                    'create objectID for XRef
                                    Dim xrid As ObjectId = db2.AttachXref(btrpathname, Path.GetFileNameWithoutExtension(btrpathname))
                                    'create block reference, reference the xref objectID
                                    Dim bref As New BlockReference(blkRef.Position, xrid)
                                    'bref.Rotation = blkRef.Rotation
                                    'bref.ScaleFactors = blkRef.ScaleFactors
                                    bref.BlockTransform = blkRef.BlockTransform

                                    'append xref to blocktable
                                    btrMs2.AppendEntity(bref)

                                    Dim blname As String = "XRef - " & Path.GetFileNameWithoutExtension(btrpathname)

                                    'Get the layer table first...
                                    Dim lt As LayerTable = trx.GetObject(db2.LayerTableId, OpenMode.ForRead)
                                    Dim layerId As ObjectId = ObjectId.Null
                                    'Check if EmployeeLayer exists...
                                    If lt.Has(blname) Then
                                        layerId = lt.Item(blname)
                                    Else
                                        'If not, create the layer here.
                                        lt.UpgradeOpen()
                                        Dim ltr As LayerTableRecord = New LayerTableRecord()
                                        ltr.Name = blname ' Set the layer name
                                        ltr.Color = Autodesk.AutoCAD.Colors.Color.FromColorIndex(Autodesk.AutoCAD.Colors.ColorMethod.ByAci, 7)
                                        layerId = lt.Add(ltr)
                                        trx.AddNewlyCreatedDBObject(ltr, True)
                                    End If
                                    'trx.Commit()

                                    bref.LayerId = layerId


                                    trx.AddNewlyCreatedDBObject(bref, True)
                                    db2.SaveAs(strFileName, DwgVersion.Current)
                                End Using
                                'End If
                            End If

                            Dim attRefIds As AttributeCollection = blkRef.AttributeCollection

                            'cycle through the attributes associated with the current block
                            For Each attrefid As ObjectId In attRefIds
                                Dim attref As AttributeReference = trans.GetObject(attrefid, OpenMode.ForRead, False)

                                Select Case attref.Tag
                                    'if block has attribute project ID then create the wblock
                                    Case "PartNumber"
                                        Dim strBlockName As String = blkRef.Name
                                        Dim btrid As ObjectId = If(blkRef.IsDynamicBlock, blkRef.DynamicBlockTableRecord, blkRef.BlockTableRecord)
                                        Dim btr2 As BlockTableRecord = DirectCast(trans.GetObject(btrid, OpenMode.ForRead), BlockTableRecord)

                                        If btr2.IsLayout OrElse btr2.IsAnonymous OrElse btr2.IsFromExternalReference OrElse btr2.IsFromOverlayReference Then
                                            editor.WriteMessage(vbLf & "Cannot convert block {0} to Xref. ", btr2.Name)
                                        Else
                                            Dim ok As Boolean = False
                                            'Add block objectID
                                            Dim oidc2 As New ObjectIdCollection
                                            oidc2.Add(blkRef.ObjectId)

                                            Dim strFileDir As String = Path.GetFileNameWithoutExtension(strFileName)
                                            Dim strSaveDir As String = Path.GetDirectoryName(strFileName)
                                            Dim strFileDirTrim As String = Mid(strFileDir, 1, 4)

                                            If Not Directory.Exists(strSaveDir & "\" & strFileDir & " - Views") Then
                                                Directory.CreateDirectory(strSaveDir & "\" & strFileDir & " - Views")
                                            End If

                                            If Not Directory.Exists(strSaveDir & "\" & strFileDir & " - Parts") Then
                                                Directory.CreateDirectory(strSaveDir & "\" & strFileDir & " - Parts")
                                            End If

                                            If Not Directory.Exists(strSaveDir & "\" & strFileDir & " - Construction") Then
                                                Directory.CreateDirectory(strSaveDir & "\" & strFileDir & " - Construction")
                                            End If
                                            If Not Directory.Exists(strSaveDir & "\" & strFileDir & " - Study") Then
                                                Directory.CreateDirectory(strSaveDir & "\" & strFileDir & " - Study")
                                            End If


                                            'Dim DestData As New Database(False, False)
                                            'Using document.LockDocument()
                                            '    DestData.ReadDwgFile("\\fs01\drivers\CAD STANDARDS\Blocks\Templates\PART DRAWING 2012 EPICOR.dwt", FileShare.ReadWrite, False, "")
                                            '    Using transNewDb As Transaction = DestData.TransactionManager.StartTransaction()
                                            '        Dim bt As BlockTable = TryCast(transNewDb.GetObject(DestData.BlockTableId, OpenMode.ForRead), BlockTable)
                                            '        Dim IDMap As New IdMapping()
                                            '        DestData.WblockCloneObjects(oidc2, bt(BlockTableRecord.ModelSpace), IDMap, DuplicateRecordCloning.Replace, False)

                                            '        'create directory to save wBlock


                                            '        transNewDb.Commit()
                                            '        DestData.SaveAs(strSaveDir & "\" & strFileDir & " - parts\" & strBlockName & ".dwg", DwgVersion.Newest)
                                            '        ok = True
                                            '    End Using
                                            'End Using


                                            Dim oidcx As New ObjectIdCollection
                                            oidcx.Add(blkRef.Id)
                                            Using tempDb As Database = database.Wblock(oidcx, blkRef.Position)
                                                tempDb.SaveAs(strSaveDir & "\" & strFileDir & " - parts\" & strBlockName & ".dwg", DwgVersion.Newest)
                                                ok = True
                                            End Using

                                            'Using target As Database = New Database(False, False)
                                            '    target.ReadDwgFile("\\test\drivers\CAD STANDARDS\Blocks\Templates\PART DRAWING 2012.dwt", FileShare.ReadWrite, False, "")
                                            '    database.Wblock(target, oidc2, blkRef.Position, DuplicateRecordCloning.Ignore)
                                            '    target.SaveAs(strSaveDir & "\" & strFileDir & " - parts\" & strBlockName & ".dwg", DwgVersion.Newest)

                                            '    ok = True
                                            'End Using

                                            If ok Then

                                                Dim strPartFile As String = strSaveDir & "\" & strFileDir & " - Parts\" & strBlockName & ".dwg"
                                                Dim db2 As Database = New Database(True, False)
                                                'read newly created dwg file
                                                db2.ReadDwgFile(strFileName, FileShare.ReadWrite, False, "")
                                                Using trx As Transaction = db2.TransactionManager.StartTransaction()
                                                    Dim xrefBt As BlockTable = trx.GetObject(db2.BlockTableId, OpenMode.ForWrite)
                                                    Dim btrMs2 As BlockTableRecord = trx.GetObject(xrefBt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)

                                                    'create objectID for XRef
                                                    Dim xrid As ObjectId = db2.AttachXref(strPartFile, Path.GetFileNameWithoutExtension(strPartFile))
                                                    'create block reference, reference the xref objectID
                                                    Dim bref As New BlockReference(blkRef.Position, xrid)
                                                    'bref.Rotation = blkRef.Rotation
                                                    bref.BlockTransform = blkRef.BlockTransform
                                                    bref.ScaleFactors = blkRef.ScaleFactors
                                                    bref.Normal = blkRef.Normal
                                                    'bref.ScaleFactors = blkRef.ScaleFactors
                                                    bref.Rotation = blkRef.Rotation
                                                    'bref.BlockTransform = blkRef.BlockTransform
                                                    bref.Position = blkRef.Position
                                                    bref.BlockUnit = blkRef.BlockUnit

                                                    'bref.Position = blkRef.Position

                                                    'append xref to blocktable

                                                    btrMs2.AppendEntity(bref)

                                                    Dim blname As String = "XRef - " & Path.GetFileNameWithoutExtension(strPartFile)

                                                    'Get the layer table first...
                                                    Dim lt As LayerTable = trx.GetObject(db2.LayerTableId, OpenMode.ForRead)
                                                    Dim layerId As ObjectId = ObjectId.Null
                                                    'Check if EmployeeLayer exists...
                                                    If lt.Has(blname) Then
                                                        layerId = lt.Item(blname)
                                                    Else
                                                        'If not, create the layer here.
                                                        lt.UpgradeOpen()
                                                        Dim ltr As LayerTableRecord = New LayerTableRecord()
                                                        ltr.Name = blname ' Set the layer name
                                                        ltr.Color = Autodesk.AutoCAD.Colors.Color.FromColorIndex(Autodesk.AutoCAD.Colors.ColorMethod.ByAci, 7)
                                                        layerId = lt.Add(ltr)
                                                        trx.AddNewlyCreatedDBObject(ltr, True)
                                                    End If
                                                    'trx.Commit()

                                                    bref.LayerId = layerId


                                                    trx.AddNewlyCreatedDBObject(bref, True)
                                                    db2.SaveAs(strFileName, DwgVersion.Current)
                                                End Using

                                            End If

                                        End If
                                End Select

                            Next

                        End If

                    Next

                End Using

            Catch ex As System.Exception
                Windows.MessageBox.Show("Error occurred: " & ex.Message, "Error", Windows.MessageBoxButton.OK, Windows.MessageBoxImage.Error)
            End Try

        End Sub

It might be good to note that if replace this piece of code:

Code: [Select]

Using tempDb As Database = database.Wblock(oidcx, blkRef.Position)
     tempDb.SaveAs(strSaveDir & "\" & strFileDir & " - parts\" & strBlockName & ".dwg", DwgVersion.Newest)
     ok = True
End Using

With this:

Code: [Select]

Using tempDb As Database = database.Wblock(blkRef.ObjectId)
       tempDb.SaveAs(strSaveDir & "\" & strFileDir & " - parts\" & strBlockName & ".dwg", DwgVersion.Newest)
       ok = True
End Using

I get desired output file, but the files added in the parts folder that was generated are no longer blocks.


Thanks in advance,

Ted

[dbalogh]

Hello,
I know this is an old topic, but I'd like to share my approach.

Code: [Select]

Public Sub SpitDrawing()
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor

            Dim sf As New SelectionFilter(New TypedValue() {New TypedValue(DxfCode.Start, "INSERT"), New TypedValue(67, 0)}) 'second tv for Modelspace only
            Dim psr As PromptSelectionResult = ed.SelectAll(sf)

            If Not psr.Status = PromptStatus.OK Then Return

            Dim OutPutPath As String = Application.GetSystemVariable("DWGPREFIX")
            Dim filelist As New List(Of String)

            Dim cnt As Integer = 0

            Using tr As Transaction = db.TransactionManager.StartTransaction
                For Each id As ObjectId In psr.Value.GetObjectIds
                    Dim br As BlockReference = tr.GetObject(id, OpenMode.ForRead)
                    Dim bname As String = String.Join("_", br.Name.Split(IO.Path.GetInvalidFileNameChars)) 'for anonymous BlockRefs :-)
                    Dim OutputFileName As String = IO.Path.Combine(OutPutPath, bname + cnt.ToString + ".dwg")

                    Dim obj As New ObjectIdCollection
                    obj.Add(id)

                    Using edb As New Database(True, False)
                        Dim ems As ObjectId = SymbolUtilityServices.GetBlockModelSpaceId(edb)
                        Dim map As New IdMapping
                        db.WblockCloneObjects(obj, ems, map, DuplicateRecordCloning.Replace, False)
                        edb.SaveAs(OutputFileName, DwgVersion.Newest)
                        edb.CloseInput(True)
                    End Using

                    br.UpgradeOpen()
                    br.Erase()

                    filelist.Add(OutputFileName)
                    cnt += 1
                Next
                tr.Commit()
            End Using

            'Using a new "tr" to get access to the files created
            Using tr As Transaction = db.TransactionManager.StartTransaction
                For Each l As String In filelist
                    Dim xrid As ObjectId = db.AttachXref(l, IO.Path.GetFileNameWithoutExtension(l))
                    Dim ms As BlockTableRecord = tr.GetObject(SymbolUtilityServices.GetBlockModelSpaceId(db), OpenMode.ForWrite)
                    Dim br As New BlockReference(New Point3d(0, 0, 0), xrid)
                    ms.AppendEntity(br)
                    tr.AddNewlyCreatedDBObject(br, True)
                Next

                tr.Commit()
            End Using
        End Sub
BR,
Daniel