Visual Basic Customization

Visual Basic Customization

Reply
Mentor
Amremad
Posts: 217
Registered: ‎08-24-2010
Message 1 of 6 (221 Views)
Accepted Solution

Create Function GetAllBlocksAttributes "any Help"

221 Views, 5 Replies
11-04-2012 01:03 AM

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  
 

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!

*Expert Elite*
Alfred.NESWADBA
Posts: 9,609
Registered: ‎06-29-2007
Message 2 of 6 (217 Views)

Re: Create Function GetAllBlocksAttributes "any Help"

11-04-2012 02:15 AM 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
-------------------------------------------------------------------------
Mentor
Amremad
Posts: 217
Registered: ‎08-24-2010
Message 3 of 6 (213 Views)

Re: Create Function GetAllBlocksAttributes "any Help"

11-04-2012 02:24 AM 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?

*Expert Elite*
Alfred.NESWADBA
Posts: 9,609
Registered: ‎06-29-2007
Message 4 of 6 (207 Views)

Re: Create Function GetAllBlocksAttributes "any Help"

11-04-2012 02:48 AM 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
-------------------------------------------------------------------------
Mentor
Amremad
Posts: 217
Registered: ‎08-24-2010
Message 5 of 6 (203 Views)

Re: Create Function GetAllBlocksAttributes "any Help"

11-04-2012 03:03 AM 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 :smileyhappy:

 

the problem that i have i this line

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

 

 

Mentor
Amremad
Posts: 217
Registered: ‎08-24-2010
Message 6 of 6 (199 Views)

Re: Create Function GetAllBlocksAttributes "any Help"

11-04-2012 03:10 AM 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??

Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Announcements
Do you have 60 seconds to spare? The Autodesk Community Team is revamping our site ranking system and we want your feedback! Please click here to launch the 5 question survey. As always your input is greatly appreciated.