CADForums.net

kemp · Guest

I know this has been addressed a million times already but I can't seem
to make it work.

I want to edit an attribute value of a block that has been inserted by
vb, the code I have hacked from this NG is this:

'Change scale attribute of blockObj
atts = blockObj.GetAttributes
For i = LBound(atts) To UBound(atts)
If UCase(atts(i).TagString) = UCase(strTag)
atts(i).TextString = strAttValue
Exit For
End If
Next

Is this correct? It is taken straight from a post on the newsgroup but
it doesn't work. Maybe my declarations are incorrect? I have tried the
following (and some variations of them) to no avail.

Dim i As Integer
Dim atts As AcadAttribute
Dim blockObj As Object
Dim strTag As String
Dim strAttValue As String

Or maybe the way I am setting the string values is all screwy...

Set strTag = "SCALE"
Set strAttValue = "testing"

Whatever it is, I'm all confused and an obvious VB newbie, so any help
sorting this out will be very appreciated!

kemp

Eduardo Chávez Vallín · Guest

Hi Kemp

After of your code maybe need Update the Object, by example

'Change scale attribute of blockObj
atts = blockObj.GetAttributes
For i = LBound(atts) To UBound(atts)
If UCase(atts(i).TagString) = UCase(strTag)
atts(i).TextString = strAttValue
Exit For
End If
Next
blockObj.Update

you try it.

"kemp" <kemp@dontemailme.com> escribió en el mensaje
news:4240a97b_3@newsprd01...

Norman Yuan · Guest

How does it not work? You get error or it runs through but the attribute
value is not changed?
I bet that the code does not run through because of syntex error:

1. You need change "Dim atts As AcadAttribute" to "Dim atts As Variant"
2. "Dim blockObj As Object" is OK if you are sure the block assgined to this
variable IS an AcadBlockreference object with Attributes
3 You do not use "Set" to assign value to a string variable, so, Set
strTag="SCALE" should be changed to strTag="SCALE".

The code for changing attribute value is correct, but you'd better add
"blockObj.Update" as the other post suggested.

"kemp" <kemp@dontemailme.com> wrote in message news:4240a97b_3@newsprd01...

Mike Tuersley · Guest

Rather than try and figure out your problem, use the code below. Just pass
the function a valid block name, valid attribute tag name, new string
value.

As for the question, and the answers, of what to declare your variables as,
don't use variant because that is technically incorrect. Variant is a vb6
cludge that is a bad habit to use if you don't need to.

If you read the help file, GetAttributes returns a Variant array of
AcadAttributereRerences. What is variant is not the data type, but the
number of AcadAttributeReferences that are returned. Therefore, the
appropriate dimensioning is:

Dim oAttRefs() As AcadAttributeReference
oAttRefs = oMyBlk.GetAttributes

This holds true for other Get methods such as getpoint. It is a good habit
to get into this approach especially if you plan to move to the .NET world
where variant is no longer accepted.

-- Mike
___________________________
Mike Tuersley
___________________________
the trick is to realize that there is no spoon...

Option Explicit

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private Function Att_Update(sBLName As String, sAttTag As String,
sNewAttVal As String) As Boolean
'+-- Change an Attributes' value given the block name and attribute tag
Dim oBlkRef As AcadBlockReference
Dim oSelSet As AcadSelectionSet
Dim oAttRef() As AcadAttributeReference
Dim iCodes(0 To 1) As Integer
Dim vCodeValues(0 To 1) As Variant
Dim iCntr As Integer
Dim ssName As String
ssName = CStr(timeGetTime)
Set oSelSet = ThisDrawing.SelectionSets.Add(ssName)
iCodes(0) = 0
vCodeValues(0) = "INSERT"
iCodes(1) = 2
vCodeValues(1) = sBLName
'set default return value
Att_Update = False
'get the blocks
oSelSet.Select Mode:=acSelectionSetAll, _
filtertype:=iCodes, _
filterdata:=vCodeValues
If sNewAttVal = "" Then sNewAttVal = " "
For Each oBlkRef In oSelSet
If oBlkRef.HasAttributes = True Then
oAttRef = oBlkRef.GetAttributes
For iCntr = LBound(oAttRef) To UBound(oAttRef)
If UCase(oAttRef(iCntr).TagString) = UCase(sAttTag) Then
oAttRef(iCntr).TextString = sNewAttVal
oAttRef(iCntr).Update
Exit For
End If
Next
Erase oAttRef
End If
Next

Exit_Here:
oSelSet.Delete
Erase oAttRef
If Not oBlkRef Is Nothing Then Set oBlkRef = Nothing
Exit Function
Error_Control:
Select Case Err.Number
Case -2147024809
'block doesn't exist
Resume Exit_Here
Case Else
MsgBox Err.Description, vbCritical
Err.Clear
Resume Exit_Here
End Select
End Function

MP · Guest

"Mike Tuersley" <mtuersley_NOT_@rand.com> wrote in message
news:1qd0wddlp5ppa.b61ffe38j717.dlg@40tude.net...

Mike Tuersley · Guest

MP · Guest

"Mike Tuersley" <mtuersley_NOT_@rand.com> wrote in message
news:us4sz4k5wryt$.dvx96jc1snbh$.dlg@40tude.net...

Jeff Mishler · Guest

I found this interesting also, Mark. However, maybe I'm approaching this
wrong.

In the following code (snagged from a post in another forum) I modified it
to be as Mike suggests. This first occurance of PickPoint carries on without
error, even though in the locals window it shows that it does NOT get set as
expected, but then in the AddCircle it errors out since it never got set.

Sub testline()
Dim objPick(0) As AcadLine
Dim PickPoint() As Double
Dim strPrompt As String

strPrompt = vbCr & "Select line: "
ThisDrawing.Utility.GetEntity objPick(0), PickPoint, strPrompt

'Next code is to test where my pickpoint is
ThisDrawing.ModelSpace.AddCircle PickPoint, 10#
End Sub

How can this be made to work without using variants?

Thanks,
--
Jeff

"MP" <nospam@Thanks.com> wrote in message news:42418a3b_1@newsprd01...

Mike Tuersley · Guest

Hey Jeff,

GetEntity returns an Object NOT a variant array of objects. Even if it did,
you have constricted your array so it won't work. The arrays always have to
be () with no value between the parenthesis.

Now why PickPoint is not working is a completely different matter. This is
what's frustrating about the Acad API. It should work as you've written
but it doesn't. For some reason, some of the utility functions actually do
kick back variants. Using your same basic code, try this:

Sub testline()
Dim PickPoint() As Double
PickPoint = ThisDrawing.Utility.GetPoint
ThisDrawing.ModelSpace.AddCircle PickPoint, 10#
End Sub

Now in the help file, both GetEntity and GetPoint return the point as a
variant array of doubles, so why does one work and the other not? That is
the question ;-) Typically, most of the methods do not return actual
variants.

-- Mike
___________________________
Mike Tuersley
___________________________
the trick is to realize that there is no spoon...

MP · Guest

that's exactly why I was so surprised what he showed worked
per the help on GetEntity (as you know)
PickedPoint

Variant (three-element array of doubles); output-only

so PickedPoint must be declared as a variant (and it will end up being
filled with an array of doubles)

however if you write a Function that returns an array

Public Function GetTablesADOX(strDatabase As String) As String()
....

End Function

Then it is possible to use an undimensioned Dynamic array "as if it were a
variant"

(I only say "as if it were a variant" since I've seen nowhere in any VB
help/Msdn that said anything other than you *cannot* assign directly to an
array)

Obviously you *can* assign directly to an undimensioned array.

Dim DynArr() as String

DynArr = GetTablesADOX

however, that still doesn't help if Acads' methods were declared like

Sub GetEntity (ByRef Obj as Object, ByRef PickedPoint as Variant, Optional
Prompt as String)

....

you will still need to feed it a variant as an argument in that case

however you say you didn't get an error so I don't know

I would have expected you'd get a Type mismatch error at the line

Jeff Mishler · Guest

"Mike Tuersley" <mtuersley_NOT_@rand.com> wrote in message
news:1t7ovvou58ggj$.whsuny17i08v.dlg@40tude.net...

Mike Tuersley · Guest

Just declare your variable as an Object --

Dim myVar As Object

-- Mike
___________________________
Mike Tuersley
___________________________
the trick is to realize that there is no spoon...

kemp · Guest

Thanks for all your help guys, I have a much better understanding of how
things work now, and my function works now too!

kemp

	CADForums.net Forum Index -> VBA	All times are GMT
Page 1 of 1