Blocks Attribute editing.

Hi!

I am trying to figure this out for 2 weeks now. I quit. Can anyone
help me?

I have a BOM on a layout. The layout is named "ORDER". Each line of my
BOM is a block called "field4". First attribute is called "ITEM" and
has a value of 1 (for the first line, 2 for the second ...). Second
attribute is called "QTY" and the third is "DESCRIPTION".

I have 20 lines on my layout.

I need to:
1: Find the "ORDER" layout.
2: Find the block called "field4".
3: If the "ITEM" = "1" then replace "QTY" with my variable QtyToOrder
and the "DESCRIPTION" with my last variable PartDescription.

Help would be sooooo appreciate, you wouldn't believe!!

Thx

 

This might work:

Private Sub TestUpDateBlkAttTarget()
Dim strBlkName As String
Dim strItemNum As String
Dim strQty As String
Dim strDescription As String
Dim stat As Integer
strBlkName = "field4"
strItemNum = "1"
strQty = "10"
strdecription = "zzzzzzzzzzzzzzzzzzzzzz"
stat = UpDateBlkAttTarget("field4", 1, strItemNum, 2, strQty, 3,
strDescription)
End Sub

Function UpDateBlkAttTarget(strBlkTarg As String, _
AttNumFind As Integer, strAttNumFind As String, _
AttNumR01 As Integer, strAttNumR01 As String, _
AttNumR02 As Integer, strAttNumR02 As String) As
Integer
Dim x As Integer
Dim fType() As Integer
Dim fData() As Variant
Const ssnam = "SSTarg"
For x = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets(x).Name = ssnam Then
ThisDrawing.SelectionSets(x).Delete
Exit For
End If
Next
'----- Establish the selection set and its filter criteria
Dim SSET1 As AcadSelectionSet
Set SSET1 = ThisDrawing.SelectionSets.Add(ssnam)
ReDim fType(0)
ReDim fData(0)
fType(0) = 2 ' dxf name group code
fData(0) = strBlkTarg ' block name
SSET1.Select acSelectionSetAll, , , fType, fData
Dim SetItem As AcadEntity
For Each SetItem In SSET1
Select Case SetItem.ObjectName
Case Is = "AcDbBlockReference"
Dim ItemBlockRef As AcadBlockReference
Dim ItemAttributes As Variant
Set ItemBlockRef = SetItem
ItemAttributes = ItemBlockRef.GetAttributes
If UBound(ItemAttributes) > -1 Then 'item has attributes
If AttNumFind > 0 Then ' avoid error but not assume 1
If Not (AttNumFind > UBound(ItemAttributes)) Then
If UCase(ItemAttributes(AttNumFind).TextString) =
UCase(strAttNumFind) Then
' attribute layer might be locked
Dim Ls As Boolean ' layer lock state
Dim IAtL As Variant ' att's layer
IAtL = ItemAttributes(AttNumFind).Layer
Ls = ThisDrawing.Layers(IAtL).Lock
ThisDrawing.Layers(IAtL).Lock = False
SetItem.Update
ItemAttributes(AttNumR01).TextString = strAttNumR01
ItemAttributes(AttNumR02).TextString = strAttNumR02
ThisDrawing.Layers(IAtL).Lock = Ls
SetItem.Update
UpDateWTID = 1 ' SUCCESS
End If
End If
End If
End If
End Select
SetItem.Update
Next
End Function

 

Thx a lot A.Seidel!

With a couple of minor modifications the procedure work fine except
that it modifies ALL the layouts first line of BOM. I only need to
change the layout named "Typical". I made that layout active before I
called the function but it doesn't change anything.

Thx again for the help, now I can see the light at the end of the
tunnel (hope it's not a train!).

Pierre Desmarais

 

MISTAKE!

The layer's name is NOT "Typical" but "ORDER".

Sorry!

Pierre Desmarais