Wblock block / CopyBlockDefinition

Hi good VBA people.

I am trying to copy one blockdefinition into another with a new name.
Does anyone know how to do this an easy way?

How can I wblock a block?

 

You can't do this directly in the current document,
because it requires you to copy the AcadBlock object,
which will not work because of the name collision.

To copy a block, follow these steps:

1. Create an ObjectDBX.AxDbDocument object.

2. Use CopyObjects to copy the AcadBlock to
the AxDbDocument's Blocks collection.

3. Rename the copy of the AcadBlock in the
AxDbDocument to a new name that does not
exist in the original document.

4. Using CopyObjects, copy the renamed AcadBlock
object from the AxDbDocument, back to the
original drawing's Blocks collection.

5. Discard the AxDbDocument.

 

Untested:

Public Function CloneBlock(ABlock As AcadBlock, NewName As String) As AcadBlock
Dim DbxDoc As New AXDB15Lib.AxDbDocument
Dim Objects(0 To 0) As AcadObject
Dim Clone As AXDB15Lib.AcadBlock
Set Objects(0) = ABlock
Dim SrcBlocks As ABlock.Document.Blocks
ABlock.Document.CopyObjects Objects, DbxDoc.Blocks
Set Clone = DbxDoc.Blocks(ABlock.Name)
Clone.Name = NewName
Set Objects(0) = Clone
DbxDoc.CopyObjects Objects, SrcBlocks
Set CloneBlock = SrcBlocks(NewName)
End Function

 

Hi Tony,
Of course I had no doubt you were correct, but by reading the Help I didn't
understand why I couldn't do this in the same drawing...obviously it doesn't
work, I just don't understand why not, again, just by reading the help file
explanation
the idea was just create new empty block def with different name and
populate with objects from existing block
don't understand why it no workie (but not surprised)

'Mark's failed attempt
Sub TestClone()
Dim oDoc As AcadDocument
Set oDoc = ThisDrawing
Dim oSBlock As AcadBlock
Dim oTblock As AcadBlock
Dim sTestBlock As String
sTestBlock = "Test"
On Error Resume Next
Set oSBlock = oDoc.Blocks.Item(sTestBlock)
If Err Then
Err.Clear
MsgBox "Test block does not exist"
Exit Sub
End If

Set oTblock = BlockCloneYeahRight(oDoc, oSBlock)

Debug.Print "Got " & oTblock.Name

Debug.Print "Returned oTblock contains: " & oTblock.Count & " items - thus:
"
For i = 0 To oTblock.Count - 1
Debug.Print oTblock.Item(i).ObjectName
Next i
Debug.Print "Done test"
End Sub

Public Function CloneBlockYeahRight(oDoc As AcadDocument, oSourceBlock As
AcadBlock) As AcadBlock
Dim vArray As Variant
Dim sSourceName As String
Dim sTargetName As String
Dim oTargetBlock As AcadBlock
sSourceName = oSourceBlock.Name
sTargetName = sSourceName & "-Clone"
Dim vpt As Variant
vpt = oSourceBlock.Origin
' Dim insPt(0 To 2) As Double
' insPt(0) = 0
' insPt(1) = 0
' insPt(2) = 0
' vpt = insPt
'

'create new block to avoid name collision
On Error Resume Next
Set oTargetBlock = oDoc.Blocks.Add(vpt, sTargetName)
If Err Then
Err.Clear
MsgBox "New name already exists"
Exit Function
End If

Dim lNumItems As Long
lNumItems = oSourceBlock.Count - 1

Dim aTemp()
ReDim aTemp(0 To lNumItems)
Dim i As Integer
For i = LBound(aTemp) To UBound(aTemp)
Debug.Print oSourceBlock.Item(i).ObjectName
Set aTemp(i) = oSourceBlock.Item(i)
Next i

Debug.Print "aTemp has " & UBound(aTemp) + 1 & " items"

'this didn't work either
'vArray = aTemp
'Debug.Print "Varray has " & UBound(vArray) + 1 & " items"
'oDoc.CopyObjects vArray, oTargetBlock

Dim vResult As Variant
oDoc.CopyObjects aTemp, oTargetBlock, vResult

Debug.Print "Results: "
For i = LBound(vResult) To UBound(vResult)
Debug.Print vResult(i)
Next i

Debug.Print "Target block contains: " & oTargetBlock.Count & " items -
thus: "
For i = 0 To oTargetBlock.Count - 1
Debug.Print oTargetBlock.Item(i).ObjectName
Next i


Set CloneBlockYeahRight = oTargetBlock

End Function


results in immediate window
AcDbPolyline
AcDbPolyline
AcDbPolyline
AcDbPolyline
AcDbPolyline
AcDbPolyline
AcDbPolyline
aTemp has 7 items
Results:
Target block contains: 0 items - thus:
Got test-Clone
Returned oTblock contains: 0 items - thus:
Done test

AcadBlock

 

Mark - Copying a block, and copying the entities in a block
are not the same thing. The block itself has properties (such
as an icon, description, design center data, and so on) and
that information is not copied when you create a new block,
and populate it with copies of the entities in the original
block. Of course, this may not be an issue, but I don't want
to make that assumption for anyone without knowledge of the
specifics of each case.

It's just another facet of my ongoing rant about avoiding
'back-door' techniques like duplicating objects using entmake
or other object creation methods, rather then true 'copying'
or 'deep-cloning' methods (a.k.a., CopyObjects).

 

Ok, I hadn't thought of those other properties, since I don't use design
center or descriptions. Good point.

but just for the sake of my ongoing education (at yours and others expense -
thanks to all) ... and in the event of not wanting to keep those
properties...for whatever reason...,
and just wanting a "duplicate" block with a new name in the same dwg,
is there something wrong with the way I'm trying to use copy objects in that
example?

I don't see what I'm doing wrong per the help files.
Am I misusing the code or is it simply not possible to duplicate entities in
the same dwg?

an example of where I might want to use something like this is if i have
several items that only vary by a few certain elements but otherwise are
very similar and would be blocks with very similar names such that a simple
string substitution could generate variations on the name, and changing
whatever items were different would provide the variations for the block
entities

the one thing that might be a problem, and which I didn't realize was the
icon...if I succeeded in making a new block this way, then when the insert
dialog was called up, you're saying there would be no icon displayed? That
would be weird.

anyway, just a theoretical attempt to see what I was doing wrong - other
than what you've already pointed out,

Thanks again,
Mark

 

Mark - It depends on what your intention is. If you simply
want to create a block whose contents are identical or copies
of another block, then that's just fine. But, copying a block
and copying its contents are two different things. If I copy
a block across drawing files, then everything goes along for
the ride (e.g., the block's properties).

So, to be consistent with copying across databases, you would
use the method I outlined. If you don't care about things like
the block icon, description, and any application data that's
associated with the block (which you may not be aware of), then
by all means, just copy the contents only.

 

My intention is to learn what I do not at the present know.

The only reason I asked again was that the code example I posted *did not
work at all* - zip - nada - zilch - that was my only curiousity....
in other words, not only did it not preserve the properties that your code
would have, it did not fill the new block with entities at all --- that was
the only thing I was asking about.

But since it's the wrong way to approach the given problem in the first
place, there's no value in getting an answer to it either..
I've already wasted enough of both of our time on this curiousity!

Thanks again
Mark

 

Mark - I didn't look at your code until just now, and
I didn't try it.

But, I'll offer this bit of advice. The first thing
you should consider doing is getting out of the habit
of using 'On Error Resume Next', because that is like
saying, 'I don't care what goes wrong, I just want it
to work'

If something's amiss, On Error Resume Next is going to
hide it.

 

Fantastic!
Some how I got the impression from my readings etc that I was supposed to
use the *ra* out of it!

try everything, trap the error, read the msg ...etc

This is like a whole new outlook on life!

Thanks
Mark

 

Now you got to go back and add error handlers to all your routines. ;-(

I got some code from vbdesign, that I modified and put into a module which adds them for you. Just click in a procedure and run the macro. Most people use a msgbox in their error handlers. I like to change its caption to show the procedure that raised the error.

--
----
Ed
----
Fantastic!
Some how I got the impression from my readings etc that I was supposed to
use the *ra* out of it!

try everything, trap the error, read the msg ...etc

This is like a whole new outlook on life!

Thanks
Mark

 

Thanks Ed,

I had to laugh cause almost on top of my pile of 'code stuff to get to as soon as i can catch my breath' is my copy of that same article from vbdesign - i've had it for a couple years laying around, reading from time to time but haven't actually run it yet, my plan is actually to rewrite slightly just to process my directory of files with the vbe and put it in all subs, a generic form that is, rather than doing it one at a time like the sample.
but i havent' got to that either yet

so now i see the little tweak in my thinking is rather than using vbe to replace "On Error" with " 'On Error"
I need to use it to replace "Resume Next" with "GoTo ErrHand"

Thanks to both of you for the knock on the door...helloooo is anyone home???



Now you got to go back and add error handlers to all your routines. ;-(