Editing Attribute Width Factor using VBA

[hendersondayton]

I have been succesful in editing the VALUE of an attribute using VBA using the following Code:

 

On Error Resume Next

With ThisDrawing

For Each oLayout In .Layouts

For k = 0 To oLayout.Block.Count - 1

Set entry = oLayout.Block.item(k)

Objname = entry.ObjectName

If Objname = "AcDbBlockReference" Then

If entry.Name Like "Title Info*" Then

atts = entry.GetAttributes

For I = LBound(atts) To UBound(atts)

If atts(I).TagString = "PG" Then

atts(I).TextString = oLayout.Name

End If

 

 

I am now trying to edit this specific attributes WIDTH FACTOR and I am having a hard time doing so.

Any suggestions would be great

[fixo]

Welcome on board!

Give that a try

 

Private Sub Ch_Att_Width(bName As String, atag As String, dblWid As Double)

    Dim oSset As AcadSelectionSet, _
        blkRef As AcadBlockReference, _
        attObj As AcadAttributeReference, _
        attData() As AcadObject, _
        fType(2) As Integer, _
        fData(2) As Variant, _
        dxfType, _
        dxfData, _
        k As Integer


    fType(0) = 0: fType(1) = 2: fType(2) = 66
    fData(0) = "INSERT": fData(1) = bName: fData(2) = 1
    dxfType = fType: dxfData = fData
    
    For Each oSset In ThisDrawing.SelectionSets
         If oSset.Name = "$Blocks$" Then
              oSset.Delete
              Exit For
         End If
    Next oSset

    Set oSset = ThisDrawing.SelectionSets.Add("$Blocks$")
    
    MsgBox "Select blocks on screen"

    oSset.SelectOnScreen dxfType, dxfData

    For Each blkRef In oSset
         attData = blkRef.GetAttributes

         For k = 0 To UBound(attData)
              Set attObj = attData(k)

              If StrComp(attObj.TagString, atag) = 0 Then
                   attObj.ScaleFactor = dblWid
                   attObj.Update
                   blkRef.Update
                   Exit For
              End If

         Next k

    Next blkRef

    oSset.Delete

    Set oSset = Nothing
    
    MsgBox "Done"

End Sub


Sub demo()
Ch_Block_Att_Width "MLR", "PRESET", 0.45
' where: "MLR" is block name,
' "PRESET" is desired tag,
' 0.45 is width factor
End Sub

 

~'J'~

[russell84]

Anotherway

 

SUB rename&changewidth()
Dim  j, k As Integer
Dim ELEMENT, ArrayAttributes


On Error Resume Next
For j = 0 To ThisDrawing.Layouts.Count - 1                 
If ThisDrawing.Layouts(j).Name = "Model" Then GoTo 10  ThisDrawing.SendCommand "layout s " & ThisDrawing.Layouts(j).Name & vbCr
               For Each ELEMENT In ThisDrawing.PaperSpace
                   If ELEMENT.EntityType = 7 Then
                       If Err Then GoTo 5
                       If ELEMENT.HasAttributes = True Then
                           ArrayAttributes = ELEMENT.GetAttributes
                           For k = LBound(ArrayAttributes) To UBound(ArrayAttributes)
                               If ArrayAttributes(k).TagString = "[color=red]TYPEATTRIBUTETAGLABELHERE[/color]" Then ArrayAttributes(k).TextString = "[color=red]TYPE TEXT TO CHANGE ATTRIBUTE TO HERE[/color]"
                               If ArrayAttributes(k).TagString = "[color=red]TYPEATTRIBUTETAGLABELHERE[/color]" Then ArrayAttributes(k).ScaleFactor = [color=red]12[/color] ' this is the width of your attribute

                           Next k
                       End If
5
                   End If
               Next
10
           Next j

End SUB