excel vba update title blocks in drawing with multiple layouts
Well, since you search the block in AcadDocument.PaperSpace, thus, you only search the active layout. Furthermore, the the active layout is ModelSpace, the code will not get anything back. There is 2 way to do:
1. Set each layout to active, then search the PaperSpace, as your code to. This would be slow, because AutoCAD has to change active layout, which, not to mention, may trigger "regen", making thing even slower;
2. You can simply loop through all layout and search AcadLayout.Block.
A slight logic optimization to your code is to let FindFrameBlock() method return an array of block references, rather than one, because it is possible you may have the same block on all paper layouts. So, here is the code to do it:
Option Explicit
Public Sub ModifyFrameBlocks()
Dim blkName As String
blkName = "TBox"
Dim i As Integer
Dim blk As AcadBlockReference
Dim blks As Variant
blks = FindBlocksOnAllLayouts(blkName)
If VarType(blks) = vbEmpty Then
MsgBox "No block """ & blkName & """ found in current drawing!"
Else
For i = 0 To UBound(blks)
Set blk = blks(i)
''Update each block reference here
Next
End If
End Sub
Private Function FindBlocksOnAllLayouts(blkName As String) As Variant
Dim blks() As AcadBlockReference
Dim i As Integer
Dim ent As AcadEntity
Dim blk As AcadBlockReference
Dim lay As AcadLayout
For Each lay In ThisDrawing.Layouts
''You may or may not wna to exclude "Model" layout
'' depending on your business requirements
If UCase(lay.Name) <> "MODEL" Then
For Each ent In lay.Block
If TypeOf ent Is AcadBlockReference Then
Set blk = ent
If UCase(blk.Name) = UCase(blkName) Then
ReDim Preserve blks(i)
Set blks(i) = blk
i = i + 1
End If
End If
Next
End If
Next
FindBlocksOnAllLayouts = blks
End Function
Of cause, if you only need to find one block, then you can stop the searching loop once a block reference is found.
Another thing to optimize your code in method ModifyFrameBlock():
Since this method gets a AcadDocument passed in, you'd better not close the document inside this method. Rather, the document should be closed outside the method. Something like:
For Each dwgName in DwgNames
''Open the drawing
Set dwg=AcadApp.Documents.Open(dwgName,...)
'' Do the work
Call ModifyFrameBlock(dwg, quantity)
''Close, save if necessary
dwg.Close True
Next
HTH
When post your code, please use "insert code" button in the message window's toolbar, so that the code can be easier for viewing.
You also should indicate where line of code does not work (if you ever stepped through the code in debugging mode, especially when the code does not work).
Anyway, it is here in your code that is wrong:
For i = 0 To UBound(blks)
Set blk = blks(i)
''Update each block reference here
If attr.TagString = "RELEASE-NO" Then
attr.TextString = "Release1"
End If
If attr.TagString = "RELEASE-DATE" Then
attr.TextString = "yyyy/mm/dd"
End If
Next
...
If should be:
For i = 0 To UBound(blks)
Set blk = blks(i)
''Update each block reference here
attrs=blk.GetAttributes()
For Each attr in attrs
If attr.TagString = "RELEASE-NO" Then
attr.TextString = "Release1"
End If
If attr.TagString = "RELEASE-DATE" Then
attr.TextString = "yyyy/mm/dd"
End If
Next
Next
Yes, you can create a selectionset with or without filter to locate the target block references. In general, it does not make much/noticeable difference in term of speed of finding the blocks. in comparison to the way of looping through AcadLayout.Block.
Accepted solution
@Anonymous wrote:
I am getting a ByRef argument type mismatch for (blkName). What am I doing wrong now. Also, is it correct to pass DWG to the
ModifyFrameBlock and FindBlocksOnAllLayouts
Dim DWG As AcadDocument
Dim releaseFile As String
Set DWG = ACAD.Documents.Open(releaseFile) ModifyFrameBlock DWG Public Sub ModifyFrameBlock(DWG As AcadDocument) Dim blkName As String blkName = "11x17_Frame_TB-2015" Dim i As Integer Dim blk As AcadBlockReference Dim blks As Variant blks = FindBlocksOnAllLayouts(blkName) 'I am getting a ByRef argument type mismatch for (blkName) If VarType(blks) = vbEmpty Then .... End If End Sub Private Function FindBlocksOnAllLayouts(DWG As AcadDocument, blkName As String) .... End Function
Well, I guess you maybe worked "too hard" to see the obvious. Take some time off in the weekend :-(.
The function FindBlocksOnAllLayouts() has 2 argument, but your code only supplys one. That line of code should be:
blks = FindBlocksOnAllLayouts(DWG, blkName)
Accepted solution
Hello,
I would like to implement this code to my excel application, but the compiler sends me error info: "Object required" and marked the line (please see picture below)
Could you help me find what is the issue?
I would appreciate for help.
It looks like the variable "attr" is not dimensioned anywhere.
Dim attr As AcadAttribute
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
AcadBlockReference returns a Variant, which is an array of AcadAttributeReference object. In VBA, For Each... Next does not apply to array, thus your code error out at:
For Each attr in attrs
...
Next
the code should be
Dim i as Integer
For i=0 to UBound(attrs)
attr=attrs(i)
If attr.TagString = "xxxx" Then
... ...
End If
Next
Firstly, please use the "</>" button of the toolbar above the message window to post code, which preserves the code format so that the code is easy to read.
Your previous code did not indicates how the variable is declared. Now, seeing the whole section of the code, here is at least 3 eerrors:
1. as I previously replied, you cannot use For Each... against an array
For Each attr in attrs
...
Next
Has to be
For i=0 to UBound(attrs)
...
Next
2. the variable "attr" is declared wrong: it should be AcadAttributeReference, not AcadAttribute
3. Since "attr" is an Object, you need to use "Set" to assign value to it
For i=....
Set attr=attrs(i)
Next
I'd strongly suggest you do wrap your code into smaller chunk, which not only makes the code much easier to follow/read/understand, but also naturally prevents the bug (of unknowingly used a variable with undesired initial value). Something like:
Private Sub SetAttributesInBlocks(blks As Variant)
Dim i As Integer
Dim blk As AcadBlockReference
For i = 0 To UBound(blks)
SetAttributes blk
Next
End Sub
Private Sub SetAttributes(blk As AcadBlockReference)
Dim i As Integer
Dim attrs As Variant
Dim attr As AcadAttributeReference
If Not blk.HasAttributes Then Exit Sub
attrs=blk.GetAttributes()
For i = 0 To UBound(attrs)
Set attr=attrs(i)
Select Case UCase(attr.TagString)
Case "REVISION"
attr.TextString="xxxxx"
Case "SHEET"
attr.TextString="yyyyy"
End Select
Next
End Sub
In addition, I would also suggest that you set your VBA Options to require variable declaration. This automatically inserts "Option Explicit" in the Declarations section of any new module you create. This will cause the IDE to notify you if you try to use a variable that hasn't been dimensioned. For existing modules, you will have to manually add the line to the top of your modules.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
If your problem is solved, please mark mark the posts accepted as solution.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.