VBA
Discuss AutoCAD ActiveX and VBA (Visual Basic for Applications) questions here.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Create Function GetAllBlocksAttributes "any Help"

5 REPLIES 5
SOLVED
Reply
Message 1 of 6
Amremad
650 Views, 5 Replies

Create Function GetAllBlocksAttributes "any Help"

Public Sub Test()
Dim Blk() As AcadBlockReference
GetAllBlocks Blk, Name
End Sub

Public Function GetAllBlocks(ByRef Blk() As AcadBlockReference, Name As String)
ReDim Blk(5) As AcadBlockReference
Dim acLayout As AcadLayout
Dim ent As AcadEntity
Dim Blk1 As AcadBlockReference
Dim Obj() As Object
    
For Each acLayout In ThisDrawing.Layouts
    For Each ent In acLayout.Block
        If TypeOf ent Is AcadBlockReference Then
            Set Blk1 = ent
            'MsgBox Blk1.Name & " - " & UBound(Blk1.GetAttributes())
        End If
    Next
Next
End Function

Hello My Friend,
At the above of this message I wrote two function
The first called “Test” that I defined Array blk without dimensions by type AcadBlockReference , and I call another function that’s name is “GetAllBlocks”

The second function called “GetAllBlocks” take two parameters ( Array Blk as  AcadBlockReference and Name as string )

My questions:
1-    Iam searching for any idea to use it in the second function can return only block attributes in the array Blk witch blk dimension equal the number of block attributes.
2-    Is there anther way to solve this problem better than this way than I write it .

Sorry for my english  
 

5 REPLIES 5
Message 2 of 6
Alfred.NESWADBA
in reply to: Amremad

Hi,

 

>>  Iam searching for any idea to use it in the second function can return only block attributes

You built the function to return an array of blockreferences (even it's not filled yet). To get them returned you have to change the code to:

 

Public Function GetAllBlocks(ByRef Blk() As AcadBlockReference, Name As String)
  ReDim Blk(5) As AcadBlockReference
  Dim acLayout As AcadLayout
  Dim ent As AcadEntity
  Dim Blk1 As AcadBlockReference
  Dim Obj() As Object
    
  For Each acLayout In ThisDrawing.Layouts
    For Each ent In acLayout.Block
        If TypeOf ent Is AcadBlockReference Then
            Set Blk1 = ent

            redim preserve Blk(ubound(blk)+1)
            set blk(ubound(blk)) = ent

            'MsgBox Blk1.Name & " - " & UBound(Blk1.GetAttributes())
        End If
    Next
  Next
End Function

With that modifications you get the blockreferences of all layouts returned to your main procedure.

What I don't know is whatfor the parameter "Name" is used in the signature of "GetAllBlocks"?

 

>> [...] the second function can return only block attributes

Can you describe the needs to do this, your workflow?

My problem in this understanding is the following: if you get all blockreferences (assuming different block-types and so different attribtutes) you get a list of attributereferences then without knowing from what blockreferences they come from/from what layout they come from, ...?

 

- alfred -

 

PS: haven't tried the code, so be careful!

------------------------------------------------------------------------------------
Alfred NESWADBA
Ingenieur Studio HOLLAUS ... www.hollaus.at ... blog.hollaus.at ... CDay 2024
------------------------------------------------------------------------------------
(not an Autodesk consultant)
Message 3 of 6
Amremad
in reply to: Alfred.NESWADBA

thank you very much , i know this way to solve but i asked if there the best way to solve or not , any way i will use it

 

Public Function GetAllBlocks(ByRef Blk() As AcadBlockReference, Name As String)

    
Dim acLayout As AcadLayout
Dim ent As AcadEntity
Dim Blk1 As AcadBlockReference
Dim Obj() As Object

For Each acLayout In ThisDrawing.Layouts
    For Each ent In acLayout.Block
        If TypeOf ent Is AcadBlockReference Then
            Set Blk1 = ent
                If Blk1.Name = Name And UBound(Blk1.GetAttributes()) > 0 Then
                    ReDim Preserve Blk(IIf(UBound(Blk) < 1, 0, UBound(Blk)) + 1)
                    Set Blk(UBound(Blk)) = ent
                End If
        End If
    Next
Next
End Function

 

now i have an error say

run time error '9' :
subscript out of range

 

so were is the problem?

Message 4 of 6
Alfred.NESWADBA
in reply to: Amremad

Hi,

 

why do you set the If in the redim syntax? If the array is empty the ubound(arr) returns -1, and that +1  = 0 for the first element. With your code:

    IIf (UBound(Blk) < 1, 0, UBound(Blk))

you always get 0 returned (except you have set the OPTION BASE parameter to 1).

 

>> subscript out of range

That may come from this line:

   If Blk1.Name = Name And UBound(Blk1.GetAttributes()) > 0 Then

Because when a blockreference has no attributereferences that function raises an exception (I think). So try instead

   Blk1.HasAttribtues

BTW: if you know the blockname (and you have not played with non usual attribute-handling) you should know if this blocktype has attributereferences or not. So maybe you even don't have to verify that by code.

 

Anyway, if you get an exception let us also know in what line you get the issue.

 

>> i asked if there the best way to solve or not

You may use the selectionset-functionality instead, if you know the name of the blockreference, then create a selectionset filtering to type=blockreference and blockname = your searched name.

You can try that (untestet):

Public Function GetBlockRefsByName(ByVal BlockName As String) As AcadSelectionSet
   Dim tDxfCodes(1) As Integer
   Dim tDxfValues(1) As Variant
   Dim tSelSet As AcadSelectionSet
   
   'create access the selectionset
   On Error Resume Next
   Set tSelSet = ThisDrawing.SelectionSets.Add("SSTemp")
   If Err.Number <> 0 Then Set tSelSet = ThisDrawing.SelectionSets.Item("SSTemp")
   tSelSet.Clear
   
   'define the filter for the selection
   tDxfCodes(0) = 0: tDxfValues(0) = "INSERT"     'filter for "is BlockReference"
   tDxfCodes(1) = 2: tDxfValues(1) = BlockName    'filter for blockname
   
   'select objects
   tSelSet.Select acSelectionSetAll, , , tDxfCode, tDxfValues
   
   Set GetBlockRefsByName = tSelSet
End Function

 

- alfred-

------------------------------------------------------------------------------------
Alfred NESWADBA
Ingenieur Studio HOLLAUS ... www.hollaus.at ... blog.hollaus.at ... CDay 2024
------------------------------------------------------------------------------------
(not an Autodesk consultant)
Message 5 of 6
Amremad
in reply to: Alfred.NESWADBA

i don't want to use selectionset method , i know it very good

 

very good to told me HasAttributes Function Smiley Happy

 

the problem that i have i this line

ReDim Preserve Blk(IIf(UBound(Blk) < 1, 0, UBound(Blk)) + 1)

 

 

Message 6 of 6
Amremad
in reply to: Amremad

i fixed my function :

 

Public Function GetAllBlocks(ByRef Blk() As AcadBlockReference, Name As String)
Dim acLayout As AcadLayout
Dim ent As AcadEntity
Dim Blk1 As AcadBlockReference
Dim Obj() As Object
ReDim Blk(0) As AcadBlockReference
For Each acLayout In ThisDrawing.Layouts
    For Each ent In acLayout.Block
        If TypeOf ent Is AcadBlockReference Then
            Set Blk1 = ent
                'MsgBox UBound(Blk)
                If Blk1.Name = Name And Blk1.HasAttributes = True Then
                    ReDim Preserve Blk(IIf(UBound(Blk) < 1, 0, UBound(Blk)) + 1)
                    Set Blk(UBound(Blk)) = ent
                End If
        End If
    Next
Next
End Function

 

so this solution you see is good and best??

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost