写块克隆--WblockCloneObjects

来源:互联网 发布:apache storm java应用 编辑:程序博客网 时间:2024/05/27 09:47
Imports ZwSoft.ZwCAD.Runtime
Imports ZwSoft.ZwCAD.DatabaseServices
Imports ZwSoft.ZwCAD.Geometry
Imports ZwSoft.ZwCAD.EditorInput
Imports ZwSoft.ZwCAD.ApplicationServices


Public Class Commands
    <CommandMethod("WblockClone")> _
    Public Shared Sub WblockClone()
        Dim ZwDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim ZwDb As Database = ZwDoc.Database
        Dim ed As Editor = ZwDoc.Editor
        Dim entity As Entity = Nothing
        Dim entityCollection As New DBObjectCollection()
        Dim ents As PromptSelectionResult = ed.GetSelection()
        If ents.Status = PromptStatus.OK Then
            Using transaction As Transaction = ZwDb.TransactionManager.StartTransaction()
                Dim SS As SelectionSet = ents.Value
                For Each id As ObjectId In SS.GetObjectIds()
                    entity = DirectCast(transaction.GetObject(id, OpenMode.ForWrite, True), Entity)
                    If entity IsNot Nothing Then
                        entityCollection.Add(entity)
                    End If
                Next
                transaction.Commit()
            End Using
        End If


        Dim Idc As New ObjectIdCollection()
        For Each obj As DBObject In entityCollection
            Idc.Add(obj.ObjectId)
        Next


        Dim nZwDb As New Database(True, True)
        Dim idBtr As New ObjectId()
        Dim map As New IdMapping()
        Using trans As Transaction = nZwDb.TransactionManager.StartTransaction()
            Dim bt As BlockTable = DirectCast(trans.GetObject(nZwDb.BlockTableId, OpenMode.ForRead), BlockTable)
            Dim modelSpace As BlockTableRecord = DirectCast(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForRead), BlockTableRecord)
            idBtr = modelSpace.ObjectId
            trans.Commit()
        End Using
        ZwDb.WblockCloneObjects(Idc, idBtr, map, DuplicateRecordCloning.Replace, False)
        nZwDb.SaveAs("d:\newDrawing.dwg", DwgVersion.Current)




    End Sub
End Class
0 0
原创粉丝点击