Copy all objects to new drawing template

[Anonymous]

I've tried this one Autodesk Developer Help

But it hangs.

What i need to do is copy all objects into a new drawingtemplate and automaticaly run some code over this.

And close the drawing where i started the program.

[Anonymous]

My first inclination would be to ask if you are using the session commandflag and if you are locking the documents.  But without seeing your code, it's hard to tell.

-Mark

[Anonymous]

Public Sub Copy2Template(ByVal oAppAutocadDWT As String, ByVal oAppMechanicalDWT As String, ByVal oAppCivilDWT As String)
        Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection()
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Dim oName As String = acDoc.Name

        Dim sTemplatePath As String = oAppAutocadDWT
        Dim oCadVer As String = Left(Right(SystemObjects.DynamicLinker.ProductKey, 7), 3)
        If oCadVer = "001" Then     'Autocad
            sTemplatePath = oAppAutocadDWT
        ElseIf oCadVer = "000" Then 'Civil
            sTemplatePath = oAppCivilDWT
        ElseIf oCadVer = "005" Then 'Mechanical
            sTemplatePath = oAppMechanicalDWT
        End If

        Dim acDocMgr As DocumentCollection = Application.DocumentManager
        Dim acNewDoc As Document = acDocMgr.Add(sTemplatePath)
        acDocMgr.MdiActiveDocument = acNewDoc
        acDoc.Database.CloseInput(True)
        acDoc.CloseAndDiscard()
    End Sub

The document is locked.

When i try to close the source dwg it says "Drawing is busy" and doesn't continue the rest of the code.

I cut the code that copies the objects, (see code above) even that doesn't work...

[Anonymous]

Your code works fine for me.  However, I set the CommandFlags.Session variable in the sub that called it.

The reason it is failing on the acDoc.CloseAndDiscard() call is because you are not calling it from the session.  When you run a command (without setting the session command flag), you are running it from the drawing that you typed the command into, which means that the code is trying to continue running after you told the document that is hosting it to close.  If you set the session commandflag it will run outside the document you are working in, and you shouldn't have any problems.

The sub you are calling should look something like this:

<CommandMethod("testcopy", CommandFlags.Session)> Public Sub testcopy()

[Anonymous]

    <CommandMethod("C2TMP", CommandFlags.Session)> _
    Public Sub C2TMP()
        Instellingen()
        Copy2Template(oAppAutocadDWT, oAppMechanicalDWT, oAppCivilDWT)
    End Sub

    Public Sub Copy2Template(ByVal oAppAutocadDWT As String, ByVal oAppMechanicalDWT As String, ByVal oAppCivilDWT As String)
        Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection()
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Dim acDocEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim acDocMgr As DocumentCollection = Application.DocumentManager
        Dim acSSPrompt As PromptSelectionResult
        acSSPrompt = acDocEd.SelectAll()
        Dim acSSet As SelectionSet = acSSPrompt.Value
        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
            For Each oSel As SelectedObject In acSSet
                acObjIdColl.Add(oSel.ObjectId)
            Next
            acTrans.Commit()
        End Using
        Dim sTemplatePath As String = oAppAutocadDWT
        Dim oCadVer As String = Left(Right(SystemObjects.DynamicLinker.ProductKey, 7), 3)
        If oCadVer = "001" Then     'Autocad
            sTemplatePath = oAppAutocadDWT
        ElseIf oCadVer = "000" Then 'Civil
            sTemplatePath = oAppCivilDWT
        ElseIf oCadVer = "005" Then 'Mechanical
            sTemplatePath = oAppMechanicalDWT
        End If

        Dim acNewDoc As Document = acDocMgr.Add(sTemplatePath)
        Dim acDbNewDoc As Database = acNewDoc.Database
        Using acLckDoc As DocumentLock = acNewDoc.LockDocument()
            Using acTrans = acDbNewDoc.TransactionManager.StartTransaction()
                Dim acBlkTblNewDoc As BlockTable
                acBlkTblNewDoc = acTrans.GetObject(acDbNewDoc.BlockTableId, OpenMode.ForRead)
                Dim acBlkTblRecNewDoc As BlockTableRecord
                acBlkTblRecNewDoc = acTrans.GetObject(acBlkTblNewDoc(BlockTableRecord.ModelSpace), OpenMode.ForRead)
                Dim acIdMap As IdMapping = New IdMapping()
                acCurDb.WblockCloneObjects(acObjIdColl, acBlkTblRecNewDoc.ObjectId, acIdMap, DuplicateRecordCloning.Ignore, False)
                acTrans.Commit()
            End Using
        End Using
        acDoc.CloseAndDiscard()
        acDocMgr.MdiActiveDocument = acNewDoc
    End Sub

 Insetllingen gets some parameters from an xml file (this works)

Then it calls to Copy2Template

Everything goes great untill the part acdoc.closeanddiscard() i get the error Drawing is busy!

I've added the CommandFlags.Session to the command as you suggested.

After the Copy2Template i need to run some more code (wich i already have but not included in this command) in the new document

[Anonymous]

Your code runs without error for me.  Seeing as Instellingen() runs prior to the code that is crashing, I would try commenting it out and seeing if that makes a difference.  Perhaps you are tying something up in the drawing, making it unable to close.  I would also look at your templates.  Does it produce the same error with all the templates?  Do the templates all have the same objects in them?

-Mark P.

[Anonymous · Accepted solution]

The Instellingen() sub did not make it crash.

What i've did to solve:

I've removed the close drawing in the copy2 template and added it to the commandsub like this:

Instellingen()
Copy2Template(oAppAutocadDWT, oAppMechanicalDWT, oAppCivilDWT)
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
acDoc.Database.CloseInput(True)
acDoc.CloseAndDiscard()

After this modification it worked without any errors.

I've added my other procedures to the command and they al work great now.

So problem solved.

Regards

Peter

[Anonymous]

I ma doing the same but one change is I want only selected entities to move to a new drawing.

and I am using this code, but it is not properly working for me  :smileysad 😞

here is the code.

Public Shared Sub SelectObjectsOnscreen()
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection()
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
Using mydoclock As DocumentLock = acDoc.LockDocument()
Dim acSSPrompt As PromptSelectionResult = acDoc.Editor.GetSelection()
If acSSPrompt.Status = PromptStatus.OK Then
Dim acSSet As SelectionSet = acSSPrompt.Value
For Each acSSObj As SelectedObject In acSSet
If Not IsDBNull(acSSObj) Then
Dim myObjID As ObjectId = acSSObj.ObjectId
acObjIdColl.Add(myObjID)
End If
Next
acSSet.Dispose()
End If
End Using
End Using
acDoc.Dispose()
Dim strTemplatePath As String = "BMGTemplate.dwt"
Dim acDocMgr As DocumentCollection = Application.DocumentManager
Dim acDoc1 As Document = acDocMgr.Add(strTemplatePath)
Dim acCurDb1 As Database = acDoc1.Database
acDocMgr.MdiActiveDocument = acDoc1 ' after this line, the Autocad is setting focus to old drawing from which I copied.
Dim ed As Editor = acDoc1.Editor
Using mydoclock As DocumentLock = acDoc1.LockDocument()
Using acTrans1 As Transaction = acCurDb1.TransactionManager.StartTransaction
Dim acBlk As BlockTable = acCurDb1.BlockTableId.GetObject(OpenMode.ForRead)
Dim acBlkrec As BlockTableRecord = acBlk(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead)
Dim acIdMap As IdMapping = New IdMapping()
acCurDb1.WblockCloneObjects(acObjIdColl, acBlkrec.Id, acIdMap, DuplicateRecordCloning.Replace, False)
acTrans1.Commit()
Application.DocumentManager.MdiActiveDocument.Editor.UpdateScreen()
Application.DocumentManager.MdiActiveDocument.Editor.Regen()
End Using
End Using
ed.Document.SendStringToExecute("._zoom _all ", True, False, False)
Dim myname As String = selectTextToName() ' this sub selects the a text in the new drawing.
Dim di As DirectoryInfo = New DirectoryInfo("C:\myToolingTDMs")
If Not di.Exists Then
di.Create()
End If
Dim mybasefileLoc As String = di.ToString + "\" + myname + "_TDM.dwg"
acDoc1.CloseAndSave(mybasefileLoc)
End Sub

Please help.

[Anonymous]

I modified my code (fast tested on Acad 2013)

Public Sub Copy2Template()
        Dim MyTemplate As String = "E:\Autocad.dwt"

        Dim oic As ObjectIdCollection = New ObjectIdCollection()

        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim ed As Editor = doc.Editor
        Dim db As Database = doc.Database
        Dim dm As DocumentCollection = Application.DocumentManager

        Dim MySelection As PromptSelectionResult = ed.GetSelection()

        If MySelection.Status = PromptStatus.OK Then
            If MySelection.Value.Count > 0 Then
                Dim ndoc As Document = DocumentCollectionExtension.Add(dm, MyTemplate)
                Dim ndb As Database = ndoc.Database

                Using dl As DocumentLock = doc.LockDocument()
                    Using tr As Transaction = db.TransactionManager.StartTransaction()
                        For Each so As SelectedObject In MySelection.Value
                            oic.Add(so.ObjectId)
                        Next
                        tr.Commit()
                    End Using
                End Using

                Using ndl As DocumentLock = ndoc.LockDocument()
                    Using ntr = ndb.TransactionManager.StartTransaction()
                        Dim nbt As BlockTable = ntr.GetObject(ndb.BlockTableId, OpenMode.ForRead)
                        Dim nbtr As BlockTableRecord = ntr.GetObject(nbt(BlockTableRecord.ModelSpace), OpenMode.ForRead)
                        Try
                            db.WblockCloneObjects(oic, nbtr.ObjectId, New IdMapping(), DuplicateRecordCloning.Ignore, False)
                        Catch ex As Exception
                        End Try
                        ntr.Commit()
                    End Using
                End Using
            End If
        End If
    End Sub

 Regards

Peter

[Anonymous]

Hi Peter, thanks for your code,

However, I cant figure out this line

Dim ndoc As Document = DocumentCollectionExtension.Add(dm, MyTemplate)

"DocumentCollectionExtension" , that one is not a function, I am using Acad 2011, is that something new added in the .net API of Acad 13, or it is a COM object ?

[Anonymous]

It seems to me that your issue is centered around the ed.GetSelection() method.

If you want the program to handle the selection, then you need to create an array of TypedValue containing your selection criteria, then create a SelectionFilter and pass the array to it.  Then call ed.GetSelection() and pass your newly created SelectionFilter to it.

If you want the user to handle the selection, then you need to create PromptSelectionOptions and set the necessary parameters in order for the ed.GetSelection() method to know what to tell the user to select.

-Mark P.

[Anonymous]

I do agree with you, what is happening is, when I am selecting through the program, on the screen, after the selection, I dont see the exit of the select, it will be still active and the other document even it is opened, it never get focussed.

[Anonymous]

@jamkhp,

Dim ndoc As Document = DocumentCollectionExtension.Add(dm, MyTemplate)

Is indeed added in the 2013 version.

This line only says that there is a new document created within the documentmanager based on a template.

You can view the code to create a new document with a template in my previous post over here.

regards

Peter

[Anonymous]

Peter,

It is some how not working for me.

could you please help.

It is for sure getting stuck when sue editor and change the document, it is not taking my new document as current and clonning, it is still woking on the old document.

[Anonymous]

jamkhp,

I've tested the folowing code on the acad 2012 version. I think you've forgot the CommandFlags.Session

Public Class cls_CopySelectedObjects
    <CommandMethod("MyCopyObjects", CommandFlags.Session)> Public Sub Copy2Template()
        Dim MyTemplate As String = "E:\Autocad.dwt"

        Dim oic As ObjectIdCollection = New ObjectIdCollection()

        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim ed As Editor = doc.Editor
        Dim db As Database = doc.Database
        Dim dm As DocumentCollection = Application.DocumentManager

        Dim MySelection As PromptSelectionResult = ed.GetSelection()

        If MySelection.Status = PromptStatus.OK Then
            If MySelection.Value.Count > 0 Then
                Dim ndoc As Document = dm.Add(MyTemplate)
                'Dim ndoc As Document = DocumentCollectionExtension.Add(dm, MyTemplate)
                Dim ndb As Database = ndoc.Database

                dm.MdiActiveDocument = ndoc

                Using dl As DocumentLock = doc.LockDocument()
                    Using tr As Transaction = db.TransactionManager.StartTransaction()
                        For Each so As SelectedObject In MySelection.Value
                            oic.Add(so.ObjectId)
                        Next
                        tr.Commit()
                    End Using
                End Using

                Using ndl As DocumentLock = ndoc.LockDocument()
                    Using ntr = ndb.TransactionManager.StartTransaction()
                        Dim nbt As BlockTable = ntr.GetObject(ndb.BlockTableId, OpenMode.ForRead)
                        Dim nbtr As BlockTableRecord = ntr.GetObject(nbt(BlockTableRecord.ModelSpace), OpenMode.ForRead)
                        Try
                            db.WblockCloneObjects(oic, nbtr.ObjectId, New IdMapping(), DuplicateRecordCloning.Ignore, False)
                        Catch ex As Exception
                        End Try
                        ntr.Commit()
                    End Using
                End Using

                dm.MdiActiveDocument = doc
            End If
        End If
    End Sub
End Class

 This code will set the selected objects in an objectcollection, opens a new drawing based on the specified template and activates this document. Then it will copy the objects into the new drawings database and then switches back to the original document, this is needed to close down the active command on the document. Now you can close the file or whatever you want.

I found a bug in the wblockcloneobjects (still there in 2013):

When the Layermanager is open in the toolpalletemode when Autocad has started you will get a fatal error, when u use the Classiclayer manager as default you won't have anny errors.

[wbdehaan]

Hi,

Your code works fine in AutoCad 2019, but it does not copy dimension lines, placed with Dimlinear and DimAligned, to the new drawing. is it maybe because the dimensionlines are blocks, and need to be added to blocktable? but I don't know how,

attached is a screenshot of 2 copied objects, a polyline and a dimensionline. with CTRL-A the grippoints are visible, and the objects are in the new drawing, only dimension is not visible

kind regards, Wouter

[Alexander.Rivilis]

---

@wbdehaan wrote:

Hi,

Your code works fine in AutoCad 2019, but it does not copy dimension lines, placed with Dimlinear and DimAligned, to the new drawing. is it maybe because the dimensionlines are blocks, and need to be added to blocktable? but I don't know how,

attached is a screenshot of 2 copied objects, a polyline and a dimensionline. with CTRL-A the grippoints are visible, and the objects are in the new drawing, only dimension is not visible

kind regards, Wouter

---

Try to call Dimension.RecomputeDimensionBlock for every copied dimension.

[wbdehaan]

Hi Alexander, 

thank You very much! it works using this code in Autocad 2019

kind regards Wouter

  For Each objId As ObjectId In MaatIDColl

                                If objId.ObjectClass.IsDerivedFrom(RXClass.GetClass(GetType(RotatedDimension))) Then
                                    Dim dimen As RotatedDimension = TryCast(MyTrans.GetObject(objId, OpenMode.ForWrite), RotatedDimension)
                                    Try
                                        'dimen.Dimscale = dimscale
                                        dimen.RecomputeDimensionBlock(True)
                                    Catch ex As System.Exception
                                        Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(ex.Message)
                                    End Try
                                End If
                            Next