"Clone" an object from one drawing to another with modifications possible?

[Anonymous]

Hi All,

     I'm hoping someone here can help me with what I've been beating my head against the wall trying to do all day.  Essentially this is the problem I'm trying to solve:

• I have two open drawings, a source and a destination drawing in ACAD
• I have different layers and linetypes in each drawing
• I need to get the objects on a specified layer in the source drawing and copy them to the destination drawing, but ensure that they are put on a specified layer in that drawing which differs in name from the original drawing.

I've tried coming at this a few different ways, but can't really seem to come a conclusion on how to do this.  WBlockCloneObjects, of course, allows me to clone the items to the new drawing, but in doing so, drags along all the layers and linetypes with it which I don't want "contaminating" my new drawing.  I'm trying to keep the conversion as clean as possible.  I can't pre-change the layer name or linetype, etc as the destination for these values doesn't exist in the source drawing. 

Is there a way to create a new entity (an anonymous one, independent of the source ObjectClass that I need so I don't have to create multiple routines to handle each one), not attached to a DB, copy the values from the source DB entity and then modify the layer, linetype, color etc before appending the entity to the destination database?

Here is my code for what I have, but since I don't really have a clue where to turn with this, all this really shows at the moment is a straight cloning of the objects from one DB to another.  As a side note, I'm working in Civil 3D 2011 and when WBlockCloneObjects is called an "AutoCAD Map Messages" window appears with no messages in it.  Anyone seen that before? 

I appreciate any help or ideas that anyone can provide,

Chris Welk

Public Function CopyLayerContents(ByVal acdocSource As Document, ByVal strSourceLayer As String, ByVal acdocDest As Document, ByVal strDestLayer As String, ByVal bCopyBlocks As Boolean) As Boolean
        Dim bComplete = False
        Dim acSourceDB As Database = acdocSource.Database
        Dim acDestDB As Database = acdocDest.Database
        Dim acSourceBlockTable As BlockTable
        Dim acSourceModelSpace As BlockTableRecord
        Dim acDestBlockTable As BlockTable
        Dim acDestModelSpace As BlockTableRecord
        Dim acSourceLayerTable As LayerTable
        Dim acDestLayerTable As LayerTable
        Dim acObjIDs As ObjectIdCollection = New ObjectIdCollection()
        Dim acIDMap As IdMapping = New IdMapping()
        

Try
            Using acDocLock As DocumentLock = acdocDest.LockDocument()
                Using acSourceTrans As Transaction = acSourceDB.TransactionManager.StartTransaction()
                    Using acDestTrans As Transaction = acDestDB.TransactionManager.StartTransaction()
                        acSourceBlockTable = acSourceTrans.GetObject(acSourceDB.BlockTableId, OpenMode.ForRead)
                        acSourceModelSpace = acSourceTrans.GetObject(acSourceBlockTable(BlockTableRecord.ModelSpace), OpenMode.ForRead)
                        acSourceLayerTable = acSourceTrans.GetObject(acSourceDB.LayerTableId, OpenMode.ForRead)
                        acDestBlockTable = acDestTrans.GetObject(acDestDB.BlockTableId, OpenMode.ForWrite)
                        acDestModelSpace = acDestTrans.GetObject(acDestBlockTable(BlockTableRecord.ModelSpace),  OpenMode.ForWrite)
                        acDestLayerTable = acDestTrans.GetObject(acDestDB.LayerTableId, OpenMode.ForRead)
                        If acSourceLayerTable.Has(strSourceLayer) And acDestLayerTable.Has(strDestLayer) Then
                            For Each acObjID As ObjectId In acSourceModelSpace
                                Dim acEnt As Entity = acSourceTrans.GetObject(acObjID, OpenMode.ForRead)
                                If acEnt.Layer = strSourceLayer Then
                                    acObjIDs.Add(acObjID)
                                End If
                            Next acObjID
                            acSourceDB.WblockCloneObjects(acObjIDs, acDestModelSpace.ObjectId, acIDMap,  _

                                DuplicateRecordCloning.Replace, False)
                            acDestTrans.Commit()

                            bComplete = True
                        Else
                            bComplete = False
                        End If

                    End Using
                End Using
            End Using
        Catch ex As Exception
            MessageBox.Show("Error importing objects: " & ex.Message & vbCrLf & vbTab & ex.StackTrace, "DASMAP - "  & System.Reflection.MethodBase.GetCurrentMethod().Name, MessageBoxButtons.OK, MessageBoxIcon.Error)
            bComplete = False
        End Try

        Return bComplete
    End Function

[Hallex]

This code is working for me (tested on A2009 only)

   Public Function CopyLayerContents(ByVal acdocDest As Document, ByVal fname As String, ByVal strSourceLayer As String, ByVal strDestLayer As String, ByVal bCopyBlocks As Boolean) As Boolean
        Dim bComplete = False
        'Dim acSourceDB As Database = acdocSource.Database
        Dim acDestDB As Database = acdocDest.Database
        Dim acSourceBlockTable As BlockTable
        Dim acSourceModelSpace As BlockTableRecord
        Dim acDestBlockTable As BlockTable
        Dim acDestModelSpace As BlockTableRecord
        Dim acSourceLayerTable As LayerTable
        Dim acDestLayerTable As LayerTable
        Dim acObjIDs As ObjectIdCollection = New ObjectIdCollection()
        Dim acIDMap As IdMapping = New IdMapping()


        Try
            Using acDocLock As DocumentLock = acdocDest.LockDocument()

                Using acSourceDB As New Database(False, True)
                    Using acSourceTrans As Transaction = acSourceDB.TransactionManager.StartTransaction()
                        acSourceDB.ReadDwgFile(fname, IO.FileShare.Read, True, "")
                        Using acDestTrans As Transaction = acDestDB.TransactionManager.StartTransaction()
                            acSourceBlockTable = acSourceTrans.GetObject(acSourceDB.BlockTableId, OpenMode.ForRead)
                            acSourceModelSpace = acSourceTrans.GetObject(acSourceBlockTable(BlockTableRecord.ModelSpace), OpenMode.ForRead)
                            acSourceLayerTable = acSourceTrans.GetObject(acSourceDB.LayerTableId, OpenMode.ForRead)
                            acDestBlockTable = acDestTrans.GetObject(acDestDB.BlockTableId, OpenMode.ForWrite)

                            acDestModelSpace = acDestTrans.GetObject(acDestBlockTable(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
                            acDestLayerTable = acDestTrans.GetObject(acDestDB.LayerTableId, OpenMode.ForRead)
                            If acSourceLayerTable.Has(strSourceLayer) And acDestLayerTable.Has(strDestLayer) Then
                                For Each acObjID As ObjectId In acSourceModelSpace
                                    Dim acEnt As Entity = acSourceTrans.GetObject(acObjID, OpenMode.ForRead)
                                    If acEnt.Layer = strSourceLayer Then
                                        acObjIDs.Add(acObjID)
                                    End If
                                Next acObjID
                                acSourceDB.WblockCloneObjects(acObjIDs, acDestModelSpace.ObjectId, acIDMap, DuplicateRecordCloning.Ignore, False)
                                acDestTrans.Commit()

                                bComplete = True
                            Else
                                bComplete = False
                            End If
                        End Using
                    End Using
                End Using
            End Using
        Catch ex As Exception
            MsgBox("Error importing objects: " & ex.Message & vbCrLf & vbTab & ex.StackTrace, MsgBoxStyle.Critical)
            bComplete = False
        End Try


        Return bComplete
    End Function
    <CommandMethod("CopyFromLayer")> _
    Public Sub CopyFromLayer()
        Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim ed As Editor = doc.Editor
        Dim fname As String = "c:\UsedFiles\abc.dwg"
        ed.WriteMessage(vbCr & vbTab & "Result = {0}", CopyLayerContents(doc, fname, "0", "0", False))

    End Sub

[Anonymous]

Thanks for the response Hallex, but that wasn't really what I was after.  Maybe I can explain it better...

The problem wasn't my code.  I only supplied it as an example of where I am currently at.  The problem I guess is more of trying to find some direction for what I'm trying to do.

My code (and yours) works fine for cloning objects between two databases.  The added caveat is that I need to partially clone those objects into the new DB. I want all aspects of the object, but want to modify the layer, linetype and color to match set properties that exist in the destination drawing.  If I just clone the objects as is, it will drag across layers and linetypes that I don't want in my destination drawing.  This would be easy if working within a single drawing, as I could clone the entity, and change the properties I need.  But since the layers and linetypes between the databases don't match, how do I go about acheiving this?

Ideas I had were:

• Importing the destination drawings, layers and linetypes into the source database, pre-editing the entities and then cloning them across to the destination database.
• Changing the source entities to a dummy layer and "ByLayer" linetype in the source drawing.  Cloning them across to the destination drawing, then modifying all entities that exist in the destination drawing on that dummy layer to match the appropriate layer/linetype properties they need to be on.
• Creating a "dummy" entity object (one not attached to a DB) that contains the properties of the source entity.  Modify the properties of that dummy entity to what I need them to be in the destination DB and then append it to the model space record.  Similar thought-proces of how you would create a new line or circle, but with a non-specific entity, so I don't have to write custom routines for the various objectclass types.  I don't even know if this one is possible.
• Create a method that looks at the ObjectClass of each entity on that layer and then runs a custom routine for each ObjectClass type to re-create the object in the destination drawing on the appropriate layer.

And that's about where my ideas run-out.  I've only been working with ACAD coding off and on for about 8 months, so I was hoping someone out there might be seeing a solution I haven't thought or wasn't aware of, and would be able to point me in the right direction.

[Anonymous]

You can probably use the IdMapping() that WBlockCloneObjects fills out to do some post-processing on the destination entities, but..

I would instead WBlockCloneObjects to a new, temporary database.  Do your layer/linetype manipulations in the temporary database, then either Insert that into the final destination or set up a new WBlockCloneObjects from temp->dest.

-drg

[chiefbraincloud · Accepted solution]

IdMapping would be one way to go, but I think you would still have to do something about the source layers being copied into the destDB.

I am making one assumption, that everything on source layer X will end up on destination layer Y, as opposed to different things on source layer X going to different destination layers.  If that is the case, then I reccomend that you open the source LayerTable and just change the names from sourcename to destname, then when you do your clone, use DuplicateRecordCloning.Ignore instead of Replace.  This would have the added benefit of automatically taking care of entities in BlockTableRecords and BlockReferences.

Depending on your actual needs, you may still need to do something about linetypes (perhaps just load the ones you need into the source and change the layer's linetype at the same time as renaming it).

[Anonymous]

Thanks for the input everyone.  I've essentially gone with chiefbraincloud's suggestion of just pre-modifying the layer and properties as needed and then cloning them over as required. 

I still have the issue of the blank "AutoCAD Map Messages" window popping up when WBlockCloneObjects executes for some reason.  But it's relatively minor, since as far as I can tell the objects are still coming across ok.  If anyone has an answer for that, feel free to post something!

Here is the updated code for anyone else who stumbles across this thread looking for a solution:

Public Function CopyLayerContents(ByVal acdocSource As Document, ByVal strSourceLayer As String, ByVal acdocDest As Document, ByVal strDestLayer As String, ByVal bCopyBlocks As Boolean) As Boolean
        Dim bComplete = False
        Dim acSourceDB As Database = acdocSource.Database
        Dim acDestDB As Database = acdocDest.Database
        Dim acSourceBlockTable As BlockTable
        Dim acSourceModelSpace As BlockTableRecord
        Dim acDestBlockTable As BlockTable
        Dim acDestModelSpace As BlockTableRecord
        Dim acSourceLayerTable As LayerTable
        Dim acDestLayerTable As LayerTable
        Dim acObjIDs As ObjectIdCollection = New ObjectIdCollection()
        Dim acIDMap As IdMapping = New IdMapping()
        Dim intCopyCount = 0
        Dim intBlockCount = 0
        Try
            Using acDestDocLock As DocumentLock = acdocDest.LockDocument()
                Using acSourceDocLock As DocumentLock = acdocSource.LockDocument()
                    Using acSourceTrans As Transaction = acSourceDB.TransactionManager.StartTransaction()
                        Using acDestTrans As Transaction = acDestDB.TransactionManager.StartTransaction()
                            acSourceBlockTable = acSourceTrans.GetObject(acSourceDB.BlockTableId, OpenMode.ForRead)
                            acSourceModelSpace = acSourceTrans.GetObject(acSourceBlockTable(BlockTableRecord.ModelSpace), OpenMode.ForRead)
                            acSourceLayerTable = acSourceTrans.GetObject(acSourceDB.LayerTableId, OpenMode.ForRead)
                            acDestBlockTable = acDestTrans.GetObject(acDestDB.BlockTableId, OpenMode.ForRead)
                            acDestModelSpace = acDestTrans.GetObject(acDestBlockTable(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
                            acDestLayerTable = acDestTrans.GetObject(acDestDB.LayerTableId, OpenMode.ForRead)
                            If acSourceLayerTable.Has(strSourceLayer) And acDestLayerTable.Has(strDestLayer) Then
                                Dim acSourceLayerTableRec As LayerTableRecord = acSourceTrans.GetObject(acSourceLayerTable(strSourceLayer), OpenMode.ForWrite)
                                Dim acSourceLineTypeTable As LinetypeTable = acSourceTrans.GetObject(acSourceDB.LinetypeTableId, OpenMode.ForRead)
                                acSourceLayerTableRec.Name = strDestLayer
                                acSourceLayerTableRec.LinetypeObjectId = acSourceLineTypeTable("Continuous")
                                For Each acObjID As ObjectId In acSourceModelSpace
                                    Using acDBObj As DBObject = acSourceTrans.GetObject(acObjID, OpenMode.ForWrite)
                                        Dim acEnt As Entity = CType(acDBObj, Entity)
                                        If acEnt.Layer = strDestLayer Then
                                            If (bCopyBlocks = False) And TypeOf (acDBObj) Is BlockReference Then
                                                'Do not copy entity as it is a block and the CopyBlocks parameter has been set to False
                                                intBlockCount += 1
                                            Else
                                                acEnt.Linetype = "ByLayer"
                                                acEnt.Color = Colors.Color.FromColorIndex(Colors.ColorMethod.ByAci, 256)
                                                acObjIDs.Add(acObjID)
                                            End If
                                        End If
                                    End Using
                                    intCopyCount += 1
                                Next acObjID
                                acSourceDB.WblockCloneObjects(acObjIDs, acDestModelSpace.ObjectId, acIDMap, DuplicateRecordCloning.Ignore, False)
                                acSourceTrans.Dispose()
                                acDestTrans.Commit()
                                bComplete = True
                            Else
                                bComplete = False
                            End If
                        End Using
                    End Using
                End Using
            End Using
        Catch ex As Exception
            MessageBox.Show("Error importing objects: " & ex.Message & vbCrLf & vbTab & ex.StackTrace, "DASMAP - " & System.Reflection.MethodBase.GetCurrentMethod().Name, MessageBoxButtons.OK, MessageBoxIcon.Error)
            bComplete = False
        End Try
        Return bComplete
    End Function

[Anonymous]

When I do 

acSourceDB.WblockCloneObjects(acObjIDs, acDestModelSpace.ObjectId, acIDMap, DuplicateRecordCloning.Ignore, False)

 can I set point of insertion?

[Alexander.Rivilis]

---

@freestyler8 wrote:

When I do 

acSourceDB.WblockCloneObjects(acObjIDs, acDestModelSpace.ObjectId, acIDMap, DuplicateRecordCloning.Ignore, False)

 can I set point of insertion?

---

No. But you can open all cloned entities and call method TransformBy for each in order to move entities in new location.

[Anonymous]

Concerning that message box issue.... maybe this will resolve it.

       static public int ErrSetLevel(short _lvl)
        {
            int resbuf_result_status = 0;
            ResultBuffer args1 = new ResultBuffer();
            args1.Add(new TypedValue((int)LispDataType.Text, "ade_errsetlevel"));
            args1.Add(new TypedValue((int)LispDataType.Int16, (short)_lvl));
            ResultBuffer resbuf_result1 = InvokeLisp(args1, ref resbuf_result_status);
            return resbuf_result_status;
        }
        [System.Security.SuppressUnmanagedCodeSecurity]
        [DllImport("acad.exe", CallingConvention = CallingConvention.Cdecl)]
        extern static private int acedInvoke(IntPtr args, out IntPtr result);
        public static ResultBuffer InvokeLisp(ResultBuffer args, ref int stat)
        {
            IntPtr rb = IntPtr.Zero;
            stat = acedInvoke(args.UnmanagedObject, out rb);
            if (stat == (int)PromptStatus.OK && rb != IntPtr.Zero)
                return (ResultBuffer)DisposableWrapper.Create(typeof(ResultBuffer), rb, true);
            return null;
        }

            ErrSetLevel((short)2);

//or 1 if memory serves..

r,

dennis

[Anonymous]

---

@Alexander.Rivilis wrote:

you can open all cloned entities and call method TransformBy for each in order to move entities in new location.

---

How to find cloned entities in destination dwg after cloning? When it was cloned, it got new ObjectID, truly?

@Anonymous, Thanks, but it so difficult for me 😞

[Alexander.Rivilis]

---

@freestyler8 wrote:

How to find cloned entities in destination dwg after cloning? When it was cloned, it got new ObjectID, truly?

---

All ObjectID's of cloned entities are in acIDMap as a idPair.Value

[Anonymous]

I make so:

  For Each idp As IdPair In acIDMap
       Try
              Dim acEnt As Object = acDestTrans.GetObject(idp.Value, OpenMode.ForWrite)
               acEnt.TransformBy(m) 'm as Matrix3d
       Catch
       End Try
  Next

 But cloned objects was Text, Line and Block. This code moves only Text. Line and Block are disappear

[Alexander.Rivilis]

---

@freestyler8 wrote:

I make so:

  For Each idp As IdPair In acIDMap
       Try
              Dim acEnt As Object = acDestTrans.GetObject(idp.Value, OpenMode.ForWrite)
               acEnt.TransformBy(m) 'm as Matrix3d
       Catch
       End Try
  Next

 But cloned objects was Text, Line and Block. This code moves only Text. Line and Block are disappear

---

You have to move only entities that acEnt.OwnerId is equal acDestModelSpace.ObjectId

[Anonymous]

---

@Alexander.Rivilis wrote:

You have to move only entities that acEnt.OwnerId is equal acDestModelSpace.ObjectId

---

Yes, acEnt.OwnerId is equal acDestModelSpace.ObjectId for three objects: Line, DBText and BlockReference. And successfully moved only DBtext.  Block and Line becomes invisible, but I can see it's central points (it's moved).

[Alexander.Rivilis]

---

@freestyler8 wrote:

Yes, acEnt.OwnerId is equal acDestModelSpace.ObjectId for three objects: Line, DBText and BlockReference. And successfully moved only DBtext.  Block and Line becomes invisible, but I can see it's central points (it's moved).

---

Maybe layer's of BlockReference and Line is off or frozen, or property Visible of those entities is False

P.S.: Without full code and a sample dwg-file I can not help you.

[Anonymous]

No, it's Visible property is True, layer is same that DText's layer.  And if I don't move it, it's visible 😞

this code:

Public Function InsertAll(sFN As String, ipt As Point3d) As Boolean

        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim acdocDest As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim acDestDB As Database = acdocDest.Database
        Dim acObjIDs As ObjectIdCollection = New ObjectIdCollection()
        Dim acIDMap As IdMapping = New IdMapping()

        Try

            Using acDocLock As DocumentLock = acdocDest.LockDocument()
                Using acSourceDB As New Database(False, True)
                    Using acSourceTrans As Transaction = acSourceDB.TransactionManager.StartTransaction()
                        acSourceDB.ReadDwgFile(sFN, IO.FileShare.Read, True, "")
                        Using acDestTrans As Transaction = acDestDB.TransactionManager.StartTransaction()

                            Dim acSourceBlockTable As BlockTable = acSourceTrans.GetObject(acSourceDB.BlockTableId, OpenMode.ForRead)
                            Dim acSourceModelSpace As BlockTableRecord = acSourceTrans.GetObject(acSourceBlockTable(BlockTableRecord.ModelSpace), OpenMode.ForRead)

                            Dim acDestBlockTable As BlockTable = acDestTrans.GetObject(acDestDB.BlockTableId, OpenMode.ForWrite)
                            Dim acDestModelSpace As BlockTableRecord = acDestTrans.GetObject(acDestBlockTable(BlockTableRecord.ModelSpace), OpenMode.ForWrite)

                            For Each acObjID As ObjectId In acSourceModelSpace
                                acObjIDs.Add(acObjID)
                            Next acObjID

                            'Copy
                            acSourceDB.WblockCloneObjects(acObjIDs, acDestModelSpace.ObjectId, acIDMap, DuplicateRecordCloning.Ignore, False)

                            'Move
                            ed.WriteMessage(ipt.ToString)
                            Dim origin As Point3d = New Point3d(0, 0, 0)
                            Dim v As Vector3d = New Vector3d(0, 0, 0)
                            Dim m As Matrix3d = Matrix3d.AlignCoordinateSystem(origin, v, v, v, ipt, v, v, v)

                            For Each idp As IdPair In acIDMap
                                Try
                                    Dim acEnt As Object = acDestTrans.GetObject(idp.Value, OpenMode.ForWrite)
                                    If acEnt.OwnerID.ToString = acDestModelSpace.ObjectId.ToString Then
                                        ed.WriteMessage(vbLf & acEnt.GetType.ToString)
                                        ed.WriteMessage(vbLf & acEnt.OwnerID.ToString)
                                        acEnt.TransformBy(m)
                                        ed.WriteMessage(vbLf & "moved")
                                    End If
                                Catch
                                    ed.WriteMessage(vbLf & "err")
                                End Try
                            Next

                            acDestTrans.Commit()
                        End Using
                    End Using
                End Using
            End Using

        Catch ex As Exception
            MsgBox("Error importing objects: " & ex.Message & vbCrLf & vbTab & ex.StackTrace, MsgBoxStyle.Critical)
        End Try

    End Function

 this result:

Autodesk.AutoCAD.DatabaseServices.BlockReference
(8796083599856)
moved
Autodesk.AutoCAD.DatabaseServices.DBText
(8796083599856)
moved
Autodesk.AutoCAD.DatabaseServices.Line
(8796083599856)
moved

[Alexander.Rivilis]

Very strange code:

Dim origin As Point3d = New Point3d(0, 0, 0)
Dim v As Vector3d = New Vector3d(0, 0, 0)
Dim m As Matrix3d = Matrix3d.AlignCoordinateSystem(origin, v, v, v, ipt, v, v, v)

 Maybe:

Dim m As Matrix3d = Matrix3d.Displacement(ipt - origin)

[Anonymous]

Yes, it works! Thank you very much!! С наступающим Вас! 🙂

[Anonymous]

sry, this was already asked, i didn't see page 2 for some reason.