insert block multiple times

[Anonymous]

Hello,

I've created a block, with an elevation-symbol for my drawings.

The routine ends with 

Set blockRefObj = ThisDrawing.PaperSpace.InsertBlock(insertionPnt, block_name, 1#, 1#, 1#, 0) 

- and this works fine.

But what if I want to insert the block multiple times? If I click on my button which creates the block, the macro stops, or after implementing an error-message, I'll be informed that the block already exists.

Is there a way to insert it? Copy works and Blocks from AutoCad itself works too, the copied or multi-times inserted ACAD-Blocks have the same name, so it seems that ther is an internal ID which I have to increase?

Knows anybody a way?

(I hope I've described my problem good enough 🙂 )

Thanks and kind regards

[norman.yuan]

When you say "I've created a block..." do you mean the block is created manually, or it is created by your code? If you only show the last line of code that works, but the not the code, it is hard for anyone to guess. Have you done your DUE DILIGENT to step through the code step by step to pin down the line of code that raises the error?

It is sounds to me that you have code that somehow creates block definition each time you want to insert the same block (as AcadBlockReference). But, not seeing relevant code, it is just a wild guess.

[Anonymous]

Okay, my explanation was not good enough, sorry for that.

So here another try 🙂

I created a block (in this case for a revision note), in VBA

Sub rev_block()

    Dim blockn_name As String
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    Dim Line_Points(0 To 5) As Double
    Dim draw_Poly As AcadLWPolyline
    Dim returnPnt As Variant
    Dim blockRefObj As AcadBlockReference
    
    Dim typeFace As String
    Dim SavetypeFace As String
    Dim Bold As Boolean
    Dim Italic As Boolean
    Dim charSet As Long
    Dim PitchandFamily As Long
    
    Dim height As Double
    Dim mode As Long
    Dim prompt1 As String
    Dim insertionPoint1(0 To 2) As Double
    Dim tag1 As String
    Dim value As String
    
    
    insertionPnt(0) = 0: insertionPnt(1) = 0: insertionPnt(2) = 0
    block_name = "REV"
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, block_name)
    
    Line_Points(0) = 0: Line_Points(1) = 0
    Line_Points(2) = 7: Line_Points(3) = 0
    Line_Points(4) = 3.5: Line_Points(5) = 6
    Set draw_Poly = blockObj.AddLightWeightPolyline(Line_Points)
    draw_Poly.Closed = True
    
    
'Save the actual textstyle
    ThisDrawing.ActiveTextStyle.GetFont typeFace, Bold, Italic, charSet, PitchandFamily
    SavetypeFace = typeFace
'set new style
    typeFace = "ISOCPEUR"
    ThisDrawing.ActiveTextStyle.SetFont typeFace, Bold, Italic, charSet, PitchandFamily
    ThisDrawing.Regen acActiveViewport
    
    height = 3.5
    mode = acAttributeModeVerify
    prompt1 = "REVISION"
    
    insertionPoint1(0) = insertionPnt(0) + 2.5: insertionPoint1(1) = insertionPnt(1) + 1: insertionPoint1(2) = 0
    tag1 = "REVISIION"
    value = "1"
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt1, insertionPoint1, tag1, value)
    
    returnPnt = ThisDrawing.Utility.GetPoint
    
    insertionPnt(0) = returnPnt(0)
    insertionPnt(1) = returnPnt(1)
    insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.PaperSpace.InsertBlock(insertionPnt, block_name, 1#, 1#, 1#, 0)
    
    ThisDrawing.ActiveTextStyle.SetFont SavetypeFace, Bold, Italic, charSet, PitchandFamily
    ThisDrawing.Regen acActiveViewport
   
End Sub

This code works, once.

If I  run it a 2nd time I get an message "lock violation".

If I run this code,  use another command and run this code again, I get the same error-message.

If I run this code, switch to another drawing, switch back to the first drawing run this code again, I can insert the block a 2nd time.

I can implement a check for the block, so I'll get a notification that the block already exists, but my target is to insert this block as many times as I want, because I need this block several times on the drawing, but I don't know how to get this done :o/

[norman.yuan · Accepted solution]

As I suspected, each time your code runs the subroutine rev_block(), your code programmatically create a block definition and then insert a block reference to that block definition. That is where the problem is: the first time run create a block with name "Rev". If you run the code again, because the block definition "Rev" already exists, thus the attempt to create a block definition with the same name would fail. 

Why do you create block definition by code instead of manually create a block and save the block for repeated use? If you insist to create block definition from your code, you only need to run it once only if the drawing does not have the block definition in ti alread. So, you need to test the block existence first. Something like:

Sub rev_Block()

  Dim block_Name As String

  block_Name=Rev"

  If Not FindBlock(block_Name) Then

    CreateBlockDefinition block_Name

  End If

  InsertBlockReference block_Name

End Sub

Function FindBlock(blkName As String) As Boolean

  On Error Resume Next

  Dim blk As AcadBlock

  Set blk =  ThisDrawing.Blocks(blkName)

  If Err.Number<>0 Then

    FindBlock(blkName = False

  Else

    FindBlock(blkName = True

  End If

End Function

Sub CreateBlockDefinition(blkName As String)

   '' place your code of creating block defition here

End Sub

Sub InsertBlockreference(blkName As string)

  '' Place code that inserts block reference here

End Sub

As you can see, divide the code into smaller chunks with each chunk does its own thing would make the code a lot easier to read/understand and fix.

[Anonymous]

Hello,

sorry for the late reply, but I was out of the office.

Thanks for your hints, the checking if the block already exists works fine and the code works now 🙂 

(I should've known this... I used it already in another script...)

And it's a very useful hint, to split the code in smaller parts, I'll try to do this in the future

Thanks and kind regards