Topic: How to immitate wblock command

[Irvin]

Hello,

How can i imitate the autocad wblock command.

When you use wblock in AutoCAD you can choose if you want wblock a block or the entire drawing. I need to wblock a block.
So that the entity's from a block are stored in a new dwg file. Witch hold the same properties as the blocktablerecord. Example:
if a blocktablerecord is annotative the new dwg should be an isannotativedwg is true. The blocktablerecord should be the new dwg.
I don't want to create a new dwg with a block in it.

Sorry for the bad description but i think you guys understand my question.

Kind regards,

Irvin

[Jeff H]

The Wblock command is a type of save command.
 
I might be wrong but I think you must create a new or overwrite a existing file.
 
Are you wanting to WblockCloneObjects into a existing drawing and save it?
 

[Irvin]

If you run wblock and you set the radiobutton to block you can choose a block from the blocktable.
On the form you can specify a blockname.dwg and the location where you want to store the new dwg file.

The newly createfile (dwg) should have te same properties when you get the blocktable record.

Do you understand?
 

[gile]

Hi,

Here's a little snippet

Code: [Select]

        private void WBlock(string blockName, string fileName)
        {
            Document doc = Application.DocumentManager.MdiActiveDocument;
            Database db = doc.Database;
            ObjectIdCollection idCol = new ObjectIdCollection();
            using (Transaction tr = db.TransactionManager.StartTransaction())
            {
                BlockTable bt = (BlockTable)tr.GetObject(db.BlockTableId, OpenMode.ForRead);
                if (!bt.Has(blockName)) return;
                BlockTableRecord btr = (BlockTableRecord)tr.GetObject(bt[blockName], OpenMode.ForRead);
                foreach (ObjectId id in btr)
                {
                    idCol.Add(id);
                }
            }
            using(Database newDb = new Database())
            using (Transaction tr = newDb.TransactionManager.StartTransaction())
            {
                BlockTable newBt = (BlockTable)tr.GetObject(newDb.BlockTableId, OpenMode.ForRead);
                IdMapping idMap = new IdMapping();
                db.WblockCloneObjects(idCol, newBt[BlockTableRecord.ModelSpace], idMap, DuplicateRecordCloning.Ignore, false);
                tr.Commit();
                newDb.SaveAs(fileName, DwgVersion.Current);
            }
        }

[fixo]

If you run wblock and you set the radiobutton to block you can choose a block from the blocktable.
On the form you can specify a blockname.dwg and the location where you want to store the new dwg file.

The newly createfile (dwg) should have te same properties when you get the blocktable record.

Do you understand?

Here is my 2 c, not tested enough:

Code: [Select]

        Public Sub CreateEmptyDwg(ByVal dwgpath As String)
            Try
                Dim db As New Database(True, True)
                db.SaveAs(dwgpath, DwgVersion.Newest)
                db.CloseInput(True)
            Catch ex As System.Exception
                Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog(ex.Message)
            End Try
        End Sub

        <CommandMethod("MWBLOCK", CommandFlags.Session)> _
        Public Sub WblockingBlock()
            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim ed As Editor = doc.Editor
            Dim db As Database = doc.Database
            Dim dwgpath As String = ""
            Dim oidc As New ObjectIdCollection()
            Try
                Using tr As Transaction = db.TransactionManager.StartTransaction()
                    Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
                    Dim btr As BlockTableRecord = TryCast(bt(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead), BlockTableRecord)
                    Dim bname As String = ed.GetString(vbCrLf + "Block name: ").StringResult
                    If bt.Has(bname) Then
                        Dim fold As String = ed.GetString(vbCrLf + "Enter folder name: ").StringResult
                        dwgpath = Path.Combine(fold, bname + ".dwg")
                        If Not File.Exists(dwgpath) Then
                            CreateEmptyDwg(dwgpath)
                        End If
                    End If
                    If Not File.Exists(dwgpath) Then
                        Return
                    End If
                    Dim blkId As ObjectId = bt(bname)
                    oidc.Add(blkId)
                    tr.Commit()
                End Using

                Using newdb As New Database

                    newdb.ReadDwgFile(dwgpath, FileOpenMode.OpenForReadAndWriteNoShare, False, "")
                   
                    Using newtr As Transaction = newdb.TransactionManager.StartTransaction()
                        Dim IDMap As New IdMapping()
                        db.WblockCloneObjects(oidc, newdb.BlockTableId, IDMap, DuplicateRecordCloning.Replace, False)
                        'here you insert this block in 0,0,0 point  usual way (it's already in the BlockTable now)
                        newtr.Commit()
                    End Using
                    newdb.SaveAs(dwgpath, DwgVersion.Current) 'A2009-working
                    'newdb.SaveAs(dwgpath, DwgVersion.Current,newdb.SecurityParameters)'<--A2010?
                End Using
            Catch ex As System.Exception
                ed.WriteMessage(ex.ToString() + vbCrLf + ex.StackTrace)
            Finally

            End Try
        End Sub

[Irvin]

Hi all,

Gile, Fixo thanks for both of your codesamples. I've got it up an running. The only thing i needed to add was a check is the btr was annotative and set the propertie of the new dwg is annotativedwg true or false. Thanks again for your help it's verry much appreciated.

Kind regards,

Irvin

[Irvin]

Hello everybody,

I've updated the code because this wasn't working for dynamicblocks.
Here's a code snippet the realy immitates the AutoCAD wblock command.

It's even simpler then we (I) tought.

Code: [Select]

[CommandMethod("MyWblockCommand")]
public void MyWblockCommand()
{
    Document doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument;
    Editor ed = doc.Editor;
    Database db = doc.Database;

    using (Transaction trans = db.TransactionManager.StartTransaction())
    {
        BlockTable bt = trans.GetObject(db.BlockTableId, OpenMode.ForRead) as BlockTable;

        using (Database tempDb = db.Wblock(bt["<any blockname within the drawing>"]))
        {
           tempDb.SaveAs("c:\\temp\\BlockToDwg.dwg", true, DwgVersion.Newest, tempDb.SecurityParameters);
        }       
        trans.Commit();
    }
}

Hope it helps someone else.

Best regards,

Irvin

[TJK44]

I have been playing around with Irvin's last bit of code here to wblock. However, is there a way to do exactly what the wblock command does except not have the block in the new drawing become exploded?

[kaefer]

I have been playing around with Irvin's last bit of code here to wblock. However, is there a way to do exactly what the wblock command does except not have the block in the new drawing become exploded?

Матрёшка alert! That wouldn't be the WBLOCK command, but something along the lines of a hypothecal CREATENESTEDBLOCK command.  Roughly:

• Select BlockReference
• Create side database
• WblockCloneObjects the BlockReference into the target's model space
• SaveAs side database

[TJK44]

What I'm trying to make happen is I want the new drawing file to look the exact same as what the wblock command does. Meaning, when wblocking out a block that has been rotated or anything it takes away the rotation and other properties (i think) and puts it at point 0,0,0. Wblockcloneobjects maintains all the properties of the block.

[TJK44]

Trying something like this to maybe change the block properties to all zeros? oidc2 will always only have one block objectid in it.

Code: [Select]

Dim destData As New Database(True, False)
                                            Using transNewDb As Transaction = destData.TransactionManager.StartTransaction()
                                                Dim bt As BlockTable = TryCast(transNewDb.GetObject(destData.BlockTableId, OpenMode.ForRead), BlockTable)
                                                Dim btrMs2 As BlockTableRecord = TryCast(bt(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead), BlockTableRecord)
                                                Dim idmap As New IdMapping
                                                'destData.WblockCloneObjects(oidc2, bt(BlockTableRecord.ModelSpace), idmap, DuplicateRecordCloning.Replace, False)

                                                database.Wblock(destData, oidc2, New Point3d(0, 0, 0), DuplicateRecordCloning.Ignore)
                                                'go through each object in the block table record
                                                For Each entID2 As ObjectId In btrMs2
                                                    'create variable used to determine is it is a block reference
                                                    Dim ent2 As Entity = transNewDb.GetObject(entID2, OpenMode.ForRead, False)
                                                    'if it is a block then perform code below
                                                    If TypeOf ent2 Is BlockReference Then
                                                        Dim blkRef2 As BlockReference = TryCast(transNewDb.GetObject(entID2, OpenMode.ForWrite, False), BlockReference)
                                                        blkRef2.Position = New Point3d(0, 0, 0)
                                                        blkRef2.Rotation = 0
                                                    End If
                                                Next
                                                transNewDb.Commit()
                                                destData.SaveAs(strSaveDir & "\" & strFileDir & " - parts\" & strBlockName & ".dwg", DwgVersion.Newest)
                                                ok = True
                                            End Using


This seems to do what I want...

Code: [Select]

Dim destData As New Database(True, False)
                                            Using transNewDb As Transaction = destData.TransactionManager.StartTransaction()
                                                Dim bt As BlockTable = TryCast(transNewDb.GetObject(destData.BlockTableId, OpenMode.ForRead), BlockTable)
                                                Dim btrMs2 As BlockTableRecord = TryCast(bt(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead), BlockTableRecord)
                                                Dim idmap As New IdMapping
                                                'destData.WblockCloneObjects(oidc2, bt(BlockTableRecord.ModelSpace), idmap, DuplicateRecordCloning.Replace, False)

                                                database.Wblock(destData, oidc2, New Point3d(0, 0, 0), DuplicateRecordCloning.Ignore)
                                                'go through each object in the block table record
                                                For Each entID2 As ObjectId In btrMs2
                                                    'create variable used to determine is it is a block reference
                                                    Dim ent2 As Entity = transNewDb.GetObject(entID2, OpenMode.ForRead, False)
                                                    'if it is a block then perform code below
                                                    If TypeOf ent2 Is BlockReference Then
                                                        Dim blkRef2 As BlockReference = TryCast(transNewDb.GetObject(entID2, OpenMode.ForWrite, False), BlockReference)
                                                        Dim vec As New Vector3d(0, 0, 1)
                                                        blkRef2.Normal = vec
                                                        blkRef2.Position = New Point3d(0, 0, 0)
                                                        blkRef2.Rotation = 0
                                                        blkRef2.ScaleFactors = New Scale3d(0)
                                                    End If
                                                Next
                                                transNewDb.Commit()
                                                destData.SaveAs(strSaveDir & "\" & strFileDir & " - parts\" & strBlockName & ".dwg", DwgVersion.Newest)
                                                ok = True
                                            End Using


[TJK44]

Well, after testing this on a couple different drawings it works on some but not others. Anyone have any ideas? Somehow I want to achieve what the wblock command does, but not explode the block because I'm losing attributes associated with the block.

[kaefer]

Well, after testing this on a couple different drawings it works on some but not others.

I was about to congratulate you, alas, apparently you didn't make it completely. The form of the Wblock method which takes a Database as first argument is news to me (interesting). Did you try another form of Wblock (that returns a fresh Database) or the WblockCloneObjects method instead, and what exactly goes wrong?

Somehow I want to achieve what the wblock command does, but not explode the block because I'm losing attributes associated with the block.

That's a good enough reason not to explode a block. Taken in isolation, it's no good reason to wrap it inside another block.

I think the problem here is that you can't state your business requirements in a few simple words, and maybe, if you could somehow structure your problem domain, more people would be able to help you out.

[TJK44]

I have tried wblockcloneobjects, but hasnt worked for what Im trying to accomplish. Which wblock method returns a new database?

In the current drawing session create X number of blocks, each block will have multiple copies in model space (mirrored, 3drotate, rotate, align). The final result I'm looking to achieve is, the user runs a command that exports these blocks into the new drawing and each block will become an xref. The new drawing will contain Only xrefs after the command has been run and will look exactly the same as the original drawing that had only blocks in it. As the command runs and encounters a block, it creates a new drawing file with only this block in it to be used for the xref in the new drawing.

First attachment is the desired output, second attachment is what is happening with current code.

[TheMaster]

What I think you're describing is what you get by using the 'select objects' form of the WBLOCK command, and selecting a single insertion of the block in model space, that is inserted with all default values (e.g., position = 0,0, scale = 1.0 , rotation = 0.0, etc.).

That should give you want you describe, and be easy to do using WblockCloneObjects().

I have been playing around with Irvin's last bit of code here to wblock. However, is there a way to do exactly what the wblock command does except not have the block in the new drawing become exploded?

[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