Keith,
Here is how I would do it.
Joe ...
Sub updlev()
Dim varAttributes As Variant
Dim ssetObj As AcadSelectionSet
Dim i, j As Integer
Dim entSSet As AcadBlockReference 'changed the data type to blockref
Dim oldlev, newlev As Single
Dim newlevStr As String
'change the way you're handling errors
On Error Resume Next
ThisDrawing.SelectionSets("BLOCKSET").Delete
Set ssetObj = ThisDrawing.SelectionSets.Add("BLOCKSET")
On Error GoTo 0
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
gpCode(0) = 0
dataValue(0) = "Insert"
Dim groupCode As Variant, dataCode As Variant
groupCode = gpCode
dataCode = dataValue
ssetObj.SelectOnScreen gpCode, dataValue
For i = 0 To ssetObj.Count - 1
Set entSSet = ssetObj.Item(i)
If entSSet.HasAttributes Then 'added this line
varAttributes = entSSet.GetAttributes
For j = LBound(varAttributes) To UBound(varAttributes)
If varAttributes(j).TagString = "0.00" Then
oldlev = Val(varAttributes(j).TextString)
newlev = oldlev - 28.16
newlevStr = Str(newlev)
varAttributes(j).TextString = newlevStr
Exit For
End If
Next j
End If
Next i
End Sub
wrote in message news:5510350@discussion.autodesk.com...
Hi, I'd be very grateful for a pointer as to why this code doesn't work. It
is to update the numeric value in a block attribute. I am very inexperienced
in VBA so there is probably a glaring mistake. Thanks.
Sub updlev()
Dim varAttributes As Variant
Dim ssetObj As AcadSelectionSet
Dim i, j As Integer
Dim entSSet As AcadObject
Dim oldlev, newlev As Single
Dim newlevStr As String
On Error GoTo Errorhandler
ssetObj.Delete
Set ssetObj = ThisDrawing.SelectionSets.Add("BLOCKSET")
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
gpCode(0) = 0
dataValue(0) = "Insert"
Dim groupCode As Variant, dataCode As Variant
groupCode = gpCode
dataCode = dataValue
ssetObj.SelectOnScreen gpCode, dataValue
For i = 0 To ssetObj.Count - 1
Set entSSet = ssetObj.Item(i)
varAttributes = entSSet.GetAttributes
For j = LBound(varAttributes) To UBound(varAttributes)
If varAttributes(j).TagString = "0.00" Then
oldlev = Val(varAttributes(j).TextString)
newlev = oldlev - 28.16
newlevStr = Str(newlev)
varAttributes(j).TextString = newlevStr
Exit For
End If
Next j
Next i
ssetObj.Delete
Exit Sub 'avoid error handler
Errorhandler:
ssetObj.Delete
MsgBox "An error was encountered, please try again", vbOKOnly
End Sub
