Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
 
<CommandMethod("CopyObjectsBetweenDatabases", CommandFlags.Session)> _
Public Sub CopyObjectsBetweenDatabases()
    Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection()

    '' Get the current document and database
    Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
    Dim acCurDb As Database = acDoc.Database

    '' Lock the current document
    Using acLckDocCur As DocumentLock = acDoc.LockDocument()

        '' Start a transaction
        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()

            '' Open the Block table for read
            Dim acBlkTbl As BlockTable
            acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)

            '' Open the Block table record Model space for write
            Dim acBlkTblRec As BlockTableRecord
            acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), _
                                            OpenMode.ForWrite)

            '' Create a circle that is at (0,0,0) with a radius of 5
            Using acCirc1 As Circle = New Circle()
                acCirc1.Center = New Point3d(0, 0, 0)
                acCirc1.Radius = 5

                '' Add the new object to the block table record and the transaction
                acBlkTblRec.AppendEntity(acCirc1)
                acTrans.AddNewlyCreatedDBObject(acCirc1, True)

                '' Create a circle that is at (0,0,0) with a radius of 7
                Using acCirc2 As Circle = New Circle()
                    acCirc2.Center = New Point3d(0, 0, 0)
                    acCirc2.Radius = 7

                    '' Add the new object to the block table record and the transaction
                    acBlkTblRec.AppendEntity(acCirc2)
                    acTrans.AddNewlyCreatedDBObject(acCirc2, True)

                    '' Add all the objects to copy to the new document
                    acObjIdColl = New ObjectIdCollection()
                    acObjIdColl.Add(acCirc1.ObjectId)
                    acObjIdColl.Add(acCirc2.ObjectId)
                End Using
            End Using

            '' Save the new objects to the database
            acTrans.Commit()
        End Using

        '' Unlock the document
    End Using

    '' Change the file and path to match a drawing template on your workstation
    Dim sLocalRoot As String = Application.GetSystemVariable("LOCALROOTPREFIX")
    Dim sTemplatePath As String = sLocalRoot + "Template\acad.dwt"

    '' Create a new drawing to copy the objects to
    Dim acDocMgr As DocumentCollection = Application.DocumentManager
    Dim acNewDoc As Document = DocumentCollectionExtension.Add(acDocMgr, sTemplatePath)
    Dim acDbNewDoc As Database = acNewDoc.Database

    '' Lock the new document
    Using acLckDoc As DocumentLock = acNewDoc.LockDocument()

        '' Start a transaction in the new database
        Using acTrans = acDbNewDoc.TransactionManager.StartTransaction()

            '' Open the Block table for read
            Dim acBlkTblNewDoc As BlockTable
            acBlkTblNewDoc = acTrans.GetObject(acDbNewDoc.BlockTableId, _
                                               OpenMode.ForRead)

            '' Open the Block table record Model space for read
            Dim acBlkTblRecNewDoc As BlockTableRecord
            acBlkTblRecNewDoc = acTrans.GetObject(acBlkTblNewDoc(BlockTableRecord.ModelSpace), _
                                                  OpenMode.ForRead)

            '' Clone the objects to the new database
            Dim acIdMap As IdMapping = New IdMapping()
            acCurDb.WblockCloneObjects(acObjIdColl, acBlkTblRecNewDoc.ObjectId, acIdMap, _
                                       DuplicateRecordCloning.Ignore, False)

            '' Save the copied objects to the database
            acTrans.Commit()
        End Using

        '' Unlock the document
    End Using

    '' Set the new document current
    acDocMgr.MdiActiveDocument = acNewDoc
End Sub

发表评论 - 不要忘了输入验证码哦！
作者：	用户：  密码：   注册？ 验证：  防止恶意留言请输入问题答案：1*3=?
评论： 禁止表情 禁止UBB 禁止图片 识别链接 识别关键字	表  情