VBA: Moving Z-Coordinate of Attribute def within Blockdefinition.

[iTijn]

I'm getting stuck on some VBA code.
Yes, I know I should migrate to .NET. VBA is pretty obsolete, but all my macro's are still in VBA and they do the job.

My target:
Moving the Z-coordinate-value of the insertion-point (or alignment-point) of an attribute-definition within a block definition.

(I will later perform an attsync on all the changed block definitions)

 

Reason:
Elevating the text in front of 'non-transparent' obejcts for better reading of text when printed.

 

Where I am:
- I have a 'Collection' of block-definitions I'd like to change.

- I cycle through all 'block-definitions' within the 'collection' .

- Recursively I cycle through all the 'Items' within the block-definition to check if the item is an AttributeDefinition.
- I'd like to set the Z-coordinate of the Attribute-def. to value 2 [mm], but am failing to do so.

 

The crucial part of the code:

    Dim AlignmentPOINT(0 To 2) As Double
    Dim CommandLineText As String
    Dim Continue As Integer
    Dim BlockAttribute As AcadAttribute
    Dim BlockAttributes As Variant
    Continue = VBA.MsgBox("Do you want to correct these blocks?", vbYesNo)
    
    If Continue = vbYes Then
        For Each BlockDef In ColBlockDefs
            For i = 0 To BlockDef.Count - 1
                If BlockDef.Item(i).EntityName = "AcDbAttributeDefinition" Then
                        BlockAttributes = BlockDef.GetAttributes
                        If BlockDef.Item(i).Alignment = acAlignmentLeft Then
                            'correct insertionpoint
                            'AlignmentPOINT = BlockDef.Item(i).InsertionPoint 'NOT WORKING
                            BlockDef.Item(i).InsertionPoint.InsertionPoint(2) = 2 '******* WHISH IT WOULD BE SO EASY ******
                        Else
                            'correct textalignment point. (to be written)
                        End If
                End If
            Next i
        Next BlockDef
    Else
            '"Aborted"
    End If

I remember having to define the destination coord's in an array of doubles first, but I can't get any of this to work.

Is there anybody out there that isn't as rusty with VBA as I am?

 

Running on AutoCAD 2013 with VBA enabler (still works fine)

CADKIT_02.dvb DC-DHB-8001 Rack layout - Sample.dwg

Edited March 30, 2021 by iTijn

[iTijn]

I have attached a sample DWG and stripped *.DVB project to the original post.
 

Edited March 30, 2021 by iTijn

[BIGAL]

I normally do lisp, for you BlockAttributes = BlockDef.GetAttributes.

 

So I would get how many attributes you dont appear to be doing that then loop through each individual attribute,  changing properties to what is required.

 

A example of looping through attributes.

 (foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 0 )) 'getattributes)
        (if (= oldtagn (strcase (vla-get-tagstring att)))
           (vla-put-textstring att newstr)
        )
      )

 

[iTijn]

Hi BIGAL,

Thank you for your help, but unfortunately I am not skilled in LISP at all. I would need a more detailed example to make that work for me.
I can already loop through the attributes of the block definition in VBA, Just need to edit the highlighted coordinate in the picture I've attached to my original post.

Can you please help with that in either VBA or LISP?
Also within LISP I wouldn't know how to make a collection blockdefinitions in the first place. (collection is filtered on some properties) 

Kind regards,

 

iTijn.

[PeterPan9720]

Hi @iTijn,

I didn't opened your code, but from what I know, attribute could be moved, if during the block creation with own attribute, has been allowed to move.

So even if in block object properties you are seeing the attribute coordinates, this (in my opinion) doesn't mean that you can move from defined position.

In any case here below a simple test code

Sub Test_Block()

For Each Object In ThisDrawing.ModelSpace
    If TypeOf Object Is AcadBlockReference Then
        If Object.HasAttributes = True Then
            A = Object.GetAttributes
            MyAttCoord = A(0).TextAlignmentPoint
            
            MyXAttCoord = MyAttCoord(0) 'Split coordinates in X, Y, Z value
            MyYAttCoord = MyAttCoord(1)
            MyZAttCoord = MyAttCoord(2)

            BlockCoord = Object.InsertionPoint 'Get Block Insertion Point Coordinates

            MyXBlockCoord = BlockCoord(0) 'Split coordinates in X, Y, Z value
            MyYBlockCoord = BlockCoord(1)
            MyZBlockCoord = BlockCoord(2)

            A(0).TextAlignmentPoint = BlockCoord 'move attribute into the same block insertion point
        End If
    End If
Next
End Sub

Bye

Edited March 30, 2021 by PeterPan9720

[BIGAL]

Just a question peterpan 

A = Object.GetAttributes
MyAttCoord = A(0).TextAlignmentPoint

 

With multiple attributes in a block does not A have a count so A(0) is it only the 1st attribute how about the rest ? In the lisp example I use if tagstring to get only 1 attribute. Just interested dont do a lot in VBA.

 

Is it For Cntr = 0 To A.Count - 1

Myattcord = A(cntr).Textalignmentpoint

Edited March 31, 2021 by BIGAL

[PeterPan9720]

Hi,

The code it's an example , but when you get attributes from a block these are stored in any case in an array, even if attribute it's only one. 

Each array row will contain attribute propertis such as the text position, or value, or color and so on.

Attributes are sequentially stored into the array in the same orde as they has been made on the block.

 

Edited March 31, 2021 by PeterPan9720

[PeterPan9720]

18 hours ago, BIGAL said:

Just a question peterpan 

A = Object.GetAttributes
MyAttCoord = A(0).TextAlignmentPoint

 

With multiple attributes in a block does not A have a count so A(0) is it only the 1st attribute how about the rest ? In the lisp example I use if tagstring to get only 1 attribute. Just interested dont do a lot in VBA.

 

Is it For Cntr = 0 To A.Count - 1

Myattcord = A(cntr).Textalignmentpoint

Hi @BIGAL, probably I answered too quickly.

Of course the next array row ( A(1), A(2) , etc) will contain next attribute properties.

But if you made a loop with a for next cycle, on the same variabile, the attribute coordinates will be applied always to the same array variable (MyAttCoord(0), MyAttCoord(1), MyAttCoord(2)). Again the above code it's only an example how to use the text attributes position.

Bye