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
Solved! Go to Solution.
Solved by Alfred.NESWADBA. Go to Solution.
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 AcadBlockReferenceDim 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!
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?
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-
i don't want to use selectionset method , i know it very good
very good to told me HasAttributes Function
the problem that i have i this line
ReDim Preserve Blk(IIf(UBound(Blk) < 1, 0, UBound(Blk)) + 1)
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.