Stuck on a drawing border question

I am trying to change the text in a drawing border but I am having a little trouble.

I am trying to use and convert code from a text book example that I have.

For Each elem In ThisDrawing.PaperSpace
If elem.EntityName = "AcDbBlockReference" Then
If elem.Name = "Part_Number" Then
foundAttributes = True
Array1 = elem.GetAttributes

I have looked at sample drawing this code works on but I cannot link the name AcDbBlockReference" with anything - can anyone help me out.

Thanks

Ian

 

First things first.

Are you trying to modify the actual text value of an attribute within a
block?

If so, you need to find the block, first. Once you have that, if I remember
correctly, you have to go through the two arrays (tag name/value name) and
find the attribute tag you are trying to change.

 

Tom

Yes I need to change the text value of the attribute within the block.

If I look at the sample and list the info of the block, I cannot see the reference name listed in the code yet it seems to be using the reference to find the block.

I'm confused

 

I understand your confusion, believe me.

Please be aware that I'm not a VBA whiz, and take note of any posts critical
of anything in the code I post. I can tell you that the snippets I'm
posting work well, in our company's circumstances. These were written
specifically for use here and most likely would need some amount of
modification for your use.

For finding the title block BLOCK, I use the following (note that this is a
snippet from a routine that goes to each layout being plotted and retrieves
information for storage in a database, no modifcation of the values was
required.)

Function GetTitleBlockInfo() As Variant
'========================================================================
Dim sTitle1 As String, sTitle2 As String, sTitle3 As String
Dim sDwgNum As String
Dim vRet(3) As Variant
Dim oLayout As AcadLayout, oLayBlock As AcadBlock
Dim oEnt As AcadEntity
Dim oBlkRef As AcadBlockReference
Set oLayout = ThisDrawing.ActiveLayout
Set oLayBlock = oLayout.Block

For Each oEnt In oLayBlock
If oEnt.ObjectName = "AcDbBlockReference" Then
Set oBlkRef = oEnt
Select Case oBlkRef.Name
Case "cectb30x42sd", "cectb24x36sd"
sTitle1 = GetAttTxtStr("TITLE_LINE_1", oBlkRef)
sTitle2 = GetAttTxtStr("TITLE_LINE_2", oBlkRef)
sTitle3 = GetAttTxtStr("TITLE_LINE_3", oBlkRef)
sDwgNum = GetAttTxtStr("PROJ_NO", oBlkRef) & "-" & _
GetAttTxtStr("DWG_NO", oBlkRef)
GoTo ValuesObtained
Case "30x42 Title", "30-42 Title Block", "24x36 Title Block", _
"Cec Title Block", "30-42_TITLE"
sTitle1 = GetAttTxtStr("TITLE_1", oBlkRef)
sTitle2 = GetAttTxtStr("TITLE_2", oBlkRef)
sTitle3 = GetAttTxtStr("TITLE_3", oBlkRef)
sDwgNum = GetAttTxtStr("DWG_NO", oBlkRef)
GoTo ValuesObtained
Case Else
sTitle1 = "": sTitle2 = "": sTitle3 = ""
sDwgNum = "000000"
End Select
End If
Next oEnt
ValuesObtained:
Set oBlkRef = Nothing
Set oLayBlock = Nothing
Set oLayout = Nothing
vRet(0) = sTitle1: vRet(1) = sTitle2: vRet(2) = sTitle3
vRet(3) = sDwgNum
GetTitleBlockInfo = vRet
End Function

The GetAttTxtStr function used in the above code is as follows:

Function GetAttTxtStr(sTagString As String, oBlkRef As AcadBlockReference)
As String
Dim vAttArr As Variant
Dim iAttCnt As Integer
Dim sRet As String
sRet = ""
If Not oBlkRef.HasAttributes Then GetAttTxtStr = sRet: Exit Function
vAttArr = oBlkRef.GetAttributes
For iAttCnt = 0 To UBound(vAttArr)
If vAttArr(iAttCnt).TagString = sTagString Then
GetAttTxtStr = vAttArr(iAttCnt).TextString
Exit Function
End If
Next
GetAttTxtStr = sRet
End Function

Again, a side note: The GetAttTxtStr could certainly use some tweaks, but
it works for here, so I didn't take it any further. It DOES have some
potential problems, though.

Hope that helps as opposed to hindering your grasp of the topic.

 

Hi Ian

Rather than looping thru all entities you would be better of creating a
selection set and filtering for blocks called "Part_Number" in paperspace.
You can then loop thru the selection set and access the attributes

Something like this...

Sub SelectBlocks()
'===========================================
Dim ss As AcadSelectionSet
Dim gpCode(1) As Integer
Dim dataValue(1) As Variant
Dim groupCode As Variant
Dim dataCode As Variant
Dim Blk As AcadBlockReference
Dim Atts As Variant
Dim i As Integer

'filter for blocks where name = "PART_NAME"
gpCode(0) = 2: dataValue(0) = "PART_NAME"
'filter for entities in paperspace
gpCode(1) = 67: dataValue(1) = 1

'assign filters to variant datatypes
groupCode = gpCode
dataCode = dataValue

'add selectionset to selectionsets collection
Set ss = ThisDrawing.SelectionSets.Add("SS_SelectBlocks")

'select all entities and apply filter
ss.Select acSelectionSetAll, , , groupCode, dataCode

'loop thru selection set
For Each Blk In ss
'check if block has attributes
If Blk.HasAttributes Then
'assign attributes to variant datatype
Atts = Blk.GetAttributes
'loop thru attributes
For i = 0 To UBound(Atts)
Debug.Print Atts(i).TagString & ": " & Atts(i).TextString
Next i
End If
Next Blk

'delete selectionset from selectionsets collection
ss.Delete

End Sub
'================================================

--
Regards
Tom Roberts
__________________________
MechWest Design & Drafting
Perth, Western Australia

 

Thanks for that I will work through it to solve my code problem.

I am very impressed how helpful people are on the forum.

Thanks again

Regards

Ian

 

Actually, if most of the entities reside in model space, then it may be
faster to iterate just the entities on the layout. And it makes for much
nicer code to boot.

 

Tom

Any chance you could drop me a mail, I'd like to send you a border example that needs to be changed for your comments.

My address is



Thanks

 

TomD

Me Again !!!

You code seems to make sense until I reach Case "cectb30x42sd", "cectb24x36sd"

What does this represent, I would appreciate it if you could drop me a mail at



I would like to ask a couple more questions if you don't mind.

I feel like I am starting to get some where at last

Regards

Ian