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'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
Solved! Go to Solution.
Solved by chiefbraincloud. Go to Solution.
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
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:
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.
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
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).
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
When I do
acSourceDB.WblockCloneObjects(acObjIDs, acDestModelSpace.ObjectId, acIDMap, DuplicateRecordCloning.Ignore, False)
can I set point of insertion?
@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.
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням! | Do you find the posts helpful? "LIKE" these posts!
Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ"
Alexander Rivilis / Александр Ривилис / Олександр Рівіліс
Programmer & Teacher & Helper / Программист - Учитель - Помощник / Програміст - вчитель - помічник
Facebook | Twitter | LinkedIn
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
@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 😞
@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
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням! | Do you find the posts helpful? "LIKE" these posts!
Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ"
Alexander Rivilis / Александр Ривилис / Олександр Рівіліс
Programmer & Teacher & Helper / Программист - Учитель - Помощник / Програміст - вчитель - помічник
Facebook | Twitter | LinkedIn
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
@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 NextBut 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
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням! | Do you find the posts helpful? "LIKE" these posts!
Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ"
Alexander Rivilis / Александр Ривилис / Олександр Рівіліс
Programmer & Teacher & Helper / Программист - Учитель - Помощник / Програміст - вчитель - помічник
Facebook | Twitter | LinkedIn
@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).
@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.
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням! | Do you find the posts helpful? "LIKE" these posts!
Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ"
Alexander Rivilis / Александр Ривилис / Олександр Рівіліс
Programmer & Teacher & Helper / Программист - Учитель - Помощник / Програміст - вчитель - помічник
Facebook | Twitter | LinkedIn
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
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)
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням! | Do you find the posts helpful? "LIKE" these posts!
Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ"
Alexander Rivilis / Александр Ривилис / Олександр Рівіліс
Programmer & Teacher & Helper / Программист - Учитель - Помощник / Програміст - вчитель - помічник
Facebook | Twitter | LinkedIn
Can't find what you're looking for? Ask the community or share your knowledge.