How to insert a block to each layout without opening that layout

[T2ioTD]

I have 65 layouts in my drawings, and it takes like 20 seconds to open each. I want to insert a block into each of them using VBA. The code is working but I cannot get rid of the line that says:

ThisDrawing.ActiveLayout = lay

without failing to insert the block save for the first layout.

Is there a way to accomplish my task without having to watch CAD opening each of the layouts? I tried

Private Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hwndLock As LongPtr) As LongPtr

but either I don't know how to use, or it fails without telling me so (being a safe pointer maybe?)

Here is the code:

''+------------------------------------------------------------------+
''|                                                                  |
''|                                                                  |
''+------------------------------------------------------------------+
Sub Copy_Block_To_All_Paper_Spaces()

Dim blockRefObj As AcadBlockReference
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 2
insertionPnt(1) = 2
insertionPnt(2) = 0

Dim lay As AcadLayout
Dim sourceDoc As AcadDocument
Set sourceDoc = ActiveDocument

For Each lay In ThisDrawing.Layouts

ThisDrawing.ActiveLayout = lay ' the problematic line...
Set blockRefObj = ThisDrawing.PaperSpace.InsertBlock(insertionPnt, "MyBlockName", 1#, 1#, 1#, 0) 

Next

End Sub

[norman.yuan · Accepted solution]

You do not have to set each layout to be ActiveLayout. You can do:

For Each lay in ThisDrawing.Layouts

    Set blkRefObject = lay.Block.InsertBlock(.......)

Next

[Ed__Jobe · Accepted solution]

Here's two ways to do it. The trick is to access the Block object of the layout. Each Layout is made up of two parts, an AcadLayout keeps the Layout's properties and a Block table record. The Layout.Block is an actual block that has a name like "Acadlayout0". It holds the Layout object's entities. The first example below uses ObjectDbx to open the file in a non-graphical interface.

Sub AddEntToAllLayouts()
    
    Dim oDbxDoc As AxDbDocument
    Dim strPath As String
    Dim str As String
    
    Dim pt(0 To 2) As Double
    Dim c As AcadCircle
    Dim lyt As AcadLayout
    pt(0) = 18#
    pt(1) = 12#
    pt(2) = 0#
    
    strPath = "C:\FilePath\Drawing1.dwg"
    
    
    Set oDbxDoc = ThisDrawing.Application.GetInterfaceObject("ObjectDBX.AxDbDocument." & Left(AcadApplication.Version, 2))
    oDbxDoc.Open (strPath)
    
    For Each lyt In oDbxDoc.Layouts
        If lyt.ModelType = False Then
            Set c = lyt.Block.AddCircle(pt, 2#)
            With c
                c.Layer = "0"
            End With
        End If
    Next
    oDbxDoc.SaveAs strPath
    
End Sub

Sub AddEntToAllLayouts2()
    
       
    Dim pt(0 To 2) As Double
    Dim c As AcadCircle
    Dim lyt As AcadLayout
    pt(0) = 18#
    pt(1) = 12#
    pt(2) = 0#
    
        
    For Each lyt In ThisDrawing.Layouts
        If lyt.ModelType = False Then 'don't do Modelspace layout
            Set c = lyt.Block.AddCircle(pt, 2#)
            With c
                c.Layer = "0"
            End With
        End If
    Next
    
End Sub

[grobnik]

@norman.yuan

Hi Norman, concerning you reply to T2ioTD post please could you confirm the difference between insert a block and add a block ?

Since I know Insert a block means that block definition shall be already defined into drawing db (Model or Layout), instead Add a block means that block it has been not yet defined into the drawing ? It's right ?

Can you help me to use a code for adding a block and inserting a block with Obdx mode ?.

I tried but without success.

Thank you.

[norman.yuan]

You should browse the object model of AutoCAD COM API in VBA's Object Browser window, which will lead you to VBA/COM API documentation by clicking "?" button in the window.

Acadxxxxxxx.Add() method is used to add an Acad object to a collection. The case case of block, AcadBlock object is a block definition, which is created by calling AcadBlocks.Add("blkName") (e.g. ThisDrawing.Blocks("blkName")). To insert a block (e.g. create an AcadBlockReference object), the method is AcadBlock.InsertBlock(), where AcadBlock could be ModelSpace, or PaperSpace (they are special AcadBlock used in AutoCAD to visually show the drawing content). When calling InsertBlock() method, you must pass a valid block name (e.g. a block definition/AcadBlock with that name must exist in the drawing), or you can pass a block file name (a file name with extension ".dwg") with or without full path. If no full path, AutoCAD would search the support file paths to locate the block drawing file. the block drawing file name without extension would then be used as block definition name. That is AutoCAD will first create a block definition before creating AcadBlockReference. If the drawing already has a block definition with the same name as the block file name, AutoCAD will simply redefine/update the existing block definition with the newly introduced block drawing file.

In the case where you want to use code to insert a block reference from nothing, then you need to use code to create a block definition (AcadBlock) first, then insert the block reference (AcadBlockReference). the pseudo code would be:

Dim blkDef As AcadBlock
Dim blkRef As AcadBlockReference
On Error Resume Next
'' Get existing block definition
Set blkDef = ThisDrawing.Blocks("MyBlock")
If errNumber<>0 Then
  '' No existing block definition, create the block definition
  Set blkDef= ThisDrawing.Blocks.Add("MyBlock")
  '' You need to add entities into the block definition to make the new block definition make sense
  blkDef.AddCircle [centerPt], [radius]
  blkDef.AddLine [startPt], [endPt]
  ... ...
End If
On Error GoTo 0
'' Create the block reference
If Not blkDef Is Nothing Then
  Set blkRef=ThisDrawing.ModelSpace[PaperSpace].InsertBlock [insPt], "MyBlock", ......
End If

[Ed__Jobe]

If you want to add the entities from a block dwg into the current dwg as a block, instead of lines 9-10 of Norman's code, you can open the dwg in ObjectDbx and copy the modelspace entities to the new block definition. Or you could use ThisDrawing.SendCommand "-INSERT "