VBA & SelectionSet Attribute Reference

[Xpeter88]

Hi All,

I am trying to create one macro to update the AutoCAD drawings - just select texts, mtexts, lines and modify their properties like lineweight, text size, text style.

 

So my drawings contains lines, Texts or MTexts and Attribute References - these files are future blocks.

 

All works fine and I believe that I am very close to finish but there is one thing that causes issues.

 

The problem occures when I am trying to select Attribute References and modify their text height. I have no idea how to select them. I tried to set

 

FilterTypeText(1) = 2
FilterDataText(1) = "*"

For Each entity In sstext
entity.color = acByLayer
entity.Height = 3.5
Next

 

but it will select some entities for which cannot mofify the text height - there is not such property and I get an error.

 

For now I put

On Error Resume Next

that will continue next on error but want to solve this.

 

See my code below.

 

Sub UpdateBlocks()
Dim sstext As AcadSelectionSet
Dim FilterTypeText(3) As Integer
Dim FilterDataText(3) As Variant
Dim tsObject As AcadTextStyle
Dim ent As AcadEntity
Dim ssall As AcadSelectionSet
Dim layer As AcadLayer
Dim entity As AcadEntity

On Error Resume Next

'set acwhite for each layer in the drawing
For Each layer In ThisDrawing.Layers
layer.color = acWhite
Next

'set all text styles
For Each tsObject In ThisDrawing.TextStyles
tsObject.fontFile = "SIMPLEX.shx"
tsObject.Width = 0.8
tsObject.Height = 3.5
Next

'select all entities and change the lineweight and color
Set ssall = ThisDrawing.SelectionSets.Add("SelectAll")
ssall.Select acSelectionSetAll

For Each ent In ssall
ent.Lineweight = acLnWt000
ent.color = acByLayer
Next

ssall.Clear
ssall.Delete

'select and change all text and Mtext

Set sstext = ThisDrawing.SelectionSets.Add("SelectText")
FilterTypeText(0) = -4
FilterDataText(0) = ""
sstext.Select acSelectionSetAll, , , FilterTypeText, FilterDataText

For Each entity In sstext
entity.color = acByLayer
entity.Height = 3.5
Next


sstext.Clear
sstext.Delete


'need select all the block attributes and move them to the standard text style or at least modify the size and textstyle


ThisDrawing.Application.ActiveDocument.PurgeAll

End Sub

 

 

Many thanks for any help,

Peter

Edited January 4, 2014 by Xpeter88

[RICVBA]

Hi All,

I am trying to create one macro to update the AutoCAD drawings - just select texts, mtexts, lines and modify their properties like lineweight, text size, text style.

 

So my drawings contains lines, Texts or MTexts and Attribute References - these files are future blocks.

 

All works fine and I believe that I am very close to finish but there is one thing that causes issues.

 

The problem occures when I am trying to select Attribute References and modify their text height. I have no idea how to select them. I tried to set

 

FilterTypeText(1) = 2
FilterDataText(1) = "*"

For Each entity In sstext
entity.color = acByLayer
entity.Height = 3.5
Next

but it will select some entities for which cannot mofify the text height - there is not such property and I get an error.

 

For now I put

On Error Resume Next

that will continue next on error but want to solve this.

 

See my code below.

 

Sub UpdateBlocks()
Dim sstext As AcadSelectionSet
Dim FilterTypeText(3) As Integer
Dim FilterDataText(3) As Variant
Dim tsObject As AcadTextStyle
Dim ent As AcadEntity
Dim ssall As AcadSelectionSet
Dim layer As AcadLayer
Dim entity As AcadEntity

On Error Resume Next

'set acwhite for each layer in the drawing
For Each layer In ThisDrawing.Layers
layer.color = acWhite
Next

'set all text styles
For Each tsObject In ThisDrawing.TextStyles
tsObject.fontFile = "SIMPLEX.shx"
tsObject.Width = 0.8
tsObject.Height = 3.5
Next

'select all entities and change the lineweight and color
Set ssall = ThisDrawing.SelectionSets.Add("SelectAll")
ssall.Select acSelectionSetAll

For Each ent In ssall
ent.Lineweight = acLnWt000
ent.color = acByLayer
Next

ssall.Clear
ssall.Delete

'select and change all text and Mtext

Set sstext = ThisDrawing.SelectionSets.Add("SelectText")
FilterTypeText(0) = -4
FilterDataText(0) = ""
sstext.Select acSelectionSetAll, , , FilterTypeText, FilterDataText

For Each entity In sstext
entity.color = acByLayer
entity.Height = 3.5
Next


sstext.Clear
sstext.Delete


'need select all the block attributes and move them to the standard text style or at least modify the size and textstyle


ThisDrawing.Application.ActiveDocument.PurgeAll

End Sub

Many thanks for any help,

Peter

 

 

 

 

 

Hi Xpeter88

 

 

at the beginning you declared "3" as the upper bound for FilterTypeText and FilterDataText vectors (i.e. they will have 4 items), but when setting filters you only set their 2nd item (index "1" - these vectors are zero based ones). this results in an error.

 

you'd Always better avoid the "On Error Resume Next" instruction while debugging so as to understand at least where you get the error.

 

furthermore, even with proper setting of vectors upperbound and indexes (both "0"), with your selection criteria you would get all objects in the drawing since you are filtering by name (Group Code =2) but then accepting every name (value="*").

 

 

Instead to select all text and mtexts you could set filters as follows

 

 Dim FilterTypeText(3) As Integer
Dim FilterDataText(3) As Variant
FilterTypeText(0) = -4: FilterDataText(0) = "<OR"
FilterTypeText(1) = 0: FilterDataText(1) = "TEXT"
FilterTypeText(2) = 0: FilterDataText(2) = "MTEXT"
FilterTypeText(3) = -4: FilterDataText(3) = "OR>"

while for acting on attribute references associated with inserted block references you could act as follows

1) select all block references

 

    Dim gpCode(0) As Integer
   Dim dataValue(0) As Variant
   Dim ssetObj As AcadSelectionSet 
   
   'selecting block references in the active drawing
   gpCode(0) = 0
   dataValue(0) = "INSERT"
   On Error Resume Next
   Set ssetObj = ThisDrawing.SelectionSets.Add("BlockRefSset")
   If Err <> 0 Then
       Set ssetObj = ThisDrawing.SelectionSets.Item("BlockRefSset")
   Else
       ssetObj.Clear
   End If
   On Error GoTo 0
   ssetObj.Select acSelectionSetAll, , , gpCode, dataValue

2) then iterate through the selectionset and acting on items who have attributes

 

    'handling block references found
   Dim nBlckRefs As Integer, iBlckRef As Integer, iAttr As Integer
   Dim Attrs As Variant
   Dim LBnd As Integer, Ubnd As Integer

   nBlckRefs = ssetObj.Count
   For iBlckRef = 0 To nBlckRefs - 1
       Set myBlckRef = ssetObj.Item(iBlckRef)
       If myBlckRef.HasAttributes Then
       
           With myBlckRef
               Attrs = .GetAttributes
           End With
           LBnd = LBound(Attrs)
           Ubnd = UBound(Attrs)
           For iAttr = LBnd To Ubnd
               Attrs(iAttr).Height = 3.5 
               Attrs(iAttr).Color = acByLayer 
           Next iAttr
       
       End If
   Next iBlckRef

[Xpeter88]

Hi,

thanks for your reply. I did a test and works fine but what I am looking for is to select atribute definition and modify it which is not a part of block (yet).

 

So these attribute definition are not inside the block. The reason is that library of "blocks" (we can call it drawings) does not contain any blocks - just lines, attribute definitions, texts and mtexts. These drawings are converted to blocks once they are inserted into the drawing and I am trying to modify these entities before they become blocks.

 

e.g. if you type command "attdef" in commandline and put this into the drawing - it's attribute defininion but not as a part of the block yet.

 

Hope it is clear:)

 

Because of this I think that code below have to be defined a bit different.

 

gpCode(0) = 0

dataValue(0) = "INSERT"

 

I just cannot select these att definitions inside the active drawing.

 

btw thanks for that 1st selection set (3), yes, there was a misstake:)

 

 

Any ideas?

 

Peter

[Tyke]

I'm not on my CAD computer at the moment, but I think if you use:

 

gpCode(0) = 0

dataValue(0) = "ATTDEF"

 

it should only pick up the attribute definitions.

[Xpeter88]

Yes that's correct. I knew that I am close but this really did not come on my mind. I am still learning to VBA.

 

Thank you both gyus, you really helped me.

Have a nice day!

 

Peter

[BIGAL]

With VBA being phased out you may want to think about going to VL or .net so dont get caught with code not working.

 

This may be usefull

Dim SS As AcadSelectionSet
Dim FilterDXFCode(0) As Integer
Dim FilterDXFVal(0) As Variant
Dim attribs As Variant

BLOCK_NAME = "SCHEDTEXT"

FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
'FilterDXFCode(1) = 2
'FilterDXFVal(1) = "SCHEDTEXT"

Set SS = ThisDrawing.SelectionSets.Add("pit1sel")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal

For Cntr = 0 To SS.Count - 1

If SS.Item(Cntr).Name = BLOCK_NAME Then

attribs = SS.Item(Cntr).GetAttributes
       
If attribs(0).TextString = pitname Then
' attribs start at 0 attrib(3) would be the 4th attribute in the block

[Xpeter88]

I know about that but for this purpose this will be enough. This code will be just a part of another code that I already have in VBA (it reads records from excel, opens the drawings,

changing the attribute values + this new part will update the textsize, colors, lines...).

 

I am learning to .NET and probably they will be re-writed to .NET but I am not able to do it now as the steps and syntax is a bit different from VBA.

 

At least I will have working code in VBA that works and a good and can take advantage of it's steps to rewrite it to .NET

 

BTW when we started to talk about .NET I know that there is a code which can transfer VBA to .NET. Do you have any expirience wiht that if it works or it's better to completly rewrite it manually.

[Xpeter88]

And thanks for that piece of code Inwill try it as soon as I get to my laptop.

[Tyke]

BTW when we started to talk about .NET I know that there is a code which can transfer VBA to .NET. Do you have any expirience wiht that if it works or it's better to completly rewrite it manually.

 

Kean Walmsley and his team from Autodesk Tech Dev produced a magic macro that will convert VBA code to VB.NET, but depending on the quality of the VBA code it has differing results. It will also convert the VB6 forms to .NET, but here again there are limitations. When I last used it you had to open the code produced from the Magic Macro in VB.NET 2008 save your project and then open it in the later versions of VB.NET you are using. I think VB.NET 2008 Express is still available as a free download if you need it. My experience using it was that there was sometimes a massive amount of debugging to do when you got your code into VB.NET and some of the VBA controls on the forms were not available in .NET. For smaller VBA projects it is really not worth all the effort to use the converter and with the larger projects it can also be a big job to get it running. Have a look at this video if you want to investigate it further:

http://download.autodesk.com/media/adn/VBA_Migration/DevTV_Recording/VBA_Migration.html

 

I now either write the code in .NET or in VBA and don't even consider using the converter. Just as an aside Autodesk no long supports VBA6 but have introduced VBA7 in AutoCAD 2014 which uses 64-bit controls on the forms, 32-bit controls are no longer supported. There are also other differences, that means the code you write in VBA6 will not necessarily run in VBA7. Whilst Autodesk have said they will continue to support VBA7 in future versions of Autodesk products they will only do that so long as Microsoft supports VBA, and that could change at any time in the future. There are no such issues with .NET so I would recommend that you change to one of the Visual Studio languages and forget writing new code in VBA. There will always be maintenance to VBA code to do and perhaps a few enhancements to existing code, so don't throw VBA completely out of the window.

[Xpeter88]

Tyke, thanks for your opinion. For now I don't need to transfer VBA to .NET but I am learning to VB.NET conventions so probably my future codes will be done in VB.NET to avoid any other issues.