Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Public Class Copy
Public Shared Sub CopyArea()
' Get the current document and database
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acDocEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Dim layoutCollectionName As List(Of String) = New List(Of String)
Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection()
Dim idcol As ObjectIdCollection = New ObjectIdCollection()
'' Start a transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
'' Request for objects to be selected in the drawing area
Dim acSSPrompt As PromptSelectionResult = acDoc.Editor.GetSelection()
'' If the prompt status is OK, objects were selected
If acSSPrompt.Status = PromptStatus.OK Then
Dim acSSet As SelectionSet = acSSPrompt.Value
'Append selected objects to the ObjectIdCollection
acObjIdColl = New ObjectIdCollection(acSSet.GetObjectIds())
'get layout dictionnary
Dim lays As DBDictionary = acTrans.GetObject(acCurDb.LayoutDictionaryId, OpenMode.ForRead)
For Each layoutEntry As DictionaryEntry In lays
Dim existingLayoutId As ObjectId = layoutEntry.Value
Dim existingLayout As Layout = TryCast(acTrans.GetObject(existingLayoutId, OpenMode.ForRead), Layout)
layoutCollectionName.Add(existingLayout.LayoutName)
Next
'prompt for which layout we should copy the selected item
Dim pKeyOpts As PromptStringOptions = New PromptStringOptions("Layout name to copy selected objects to :")
Dim pKeyRes As PromptResult = acDoc.Editor.GetString(pKeyOpts)
If pKeyRes.Status = PromptStatus.OK Then
'check if the entered string matches an existing layout name
If Not layoutCollectionName.Contains(pKeyRes.StringResult) Then
Application.ShowAlertDialog("Entered layout name: " & pKeyRes.StringResult & " does not exist. Exiting application.")
Exit Sub
End If
Using acLckDoc As DocumentLock = acDoc.LockDocument()
'get the selected layout BlockTableRercord
Dim selectLayoutName As Layout = TryCast(lays.GetAt(pKeyRes.StringResult).GetObject(OpenMode.ForRead), Layout)
Dim selectedLayoutBtr As BlockTableRecord = TryCast(acTrans.GetObject(selectLayoutName.BlockTableRecordId, OpenMode.ForRead), BlockTableRecord)
'Copy the object to the selected layout
For Each id As ObjectId In acObjIdColl
'check if entity is a viewport
If (id.ObjectClass.DxfName.ToUpper = "VIEWPORT") Then
idcol.Add(id)
Dim idmap As New IdMapping
selectLayoutName.UpgradeOpen()
acCurDb.DeepCloneObjects(idcol, selectLayoutName.BlockTableRecordId, idmap, False)
Else
Dim ent As Entity = DirectCast(acTrans.GetObject(id, OpenMode.ForWrite, False), Entity)
Dim copiedEnt As Entity = DirectCast(ent.Clone(), Entity)
selectedLayoutBtr.UpgradeOpen()
selectedLayoutBtr.AppendEntity(copiedEnt)
acTrans.AddNewlyCreatedDBObject(copiedEnt, True)
End If
Next
End Using
End If
End If
acTrans.Commit()
acDocEd.Regen()
End Using
End Sub
End Class
For Each id As ObjectId In acObjIdColl
' 'check if entity is a viewport
' If (id.ObjectClass.DxfName.ToUpper = "VIEWPORT") Then
' idcol.Add(id)
' Dim idmap As New IdMapping
' selectLayoutName.UpgradeOpen()
' acCurDb.DeepCloneObjects(idcol, selectLayoutName.BlockTableRecordId, idmap, False)
' Else
' Dim ent As Entity = DirectCast(acTrans.GetObject(id, OpenMode.ForWrite, False), Entity)
' Dim copiedEnt As Entity = DirectCast(ent.Clone(), Entity)
' selectedLayoutBtr.UpgradeOpen()
' selectedLayoutBtr.AppendEntity(copiedEnt)
' acTrans.AddNewlyCreatedDBObject(copiedEnt, True)
' End If
For Each id As ObjectId In acObjIdColl
Dim obj As DBObject = acTrans.GetObject(id, OpenMode.ForRead)
Dim dbViewport As Viewport = TryCast(obj, Viewport)
If dbViewport IsNot Nothing Then
idcol.Add(id)
Else
Dim ent As Entity = DirectCast(acTrans.GetObject(id, OpenMode.ForWrite, False), Entity)
Dim copiedEnt As Entity = DirectCast(ent.Clone(), Entity)
selectedLayoutBtr.UpgradeOpen()
selectedLayoutBtr.AppendEntity(copiedEnt)
acTrans.AddNewlyCreatedDBObject(copiedEnt, True)
End If
Next
'go for the deepcloning on the ViewportCollection
Dim idmap As New IdMapping
selectLayoutName.UpgradeOpen()
acCurDb.DeepCloneObjects(idcol, selectLayoutName.BlockTableRecordId, idmap, False)