TheSwamp
Code Red => VB(A) => Topic started by: mohnston on October 30, 2006, 06:51:02 PM
-
This is an AutoCAD 2007 issue.
I have upgraded (?) some blocks from standard blocks to dynamic blocks and now I find that some of my code will not find the blocks by name because dynamic blocks are assigned anonymous names. (*U???)
There is a new blockreference property, .EffectiveName, that I can use to build a selection set but I would prefer for users to see selections filtered during the selection and not after. Besides, I have other functions that rely on filtering on block name and I don't want to re-write them.
Is there a way to build a selection set filter that will look for DXF subclass markers?
For example:
0 = "INSERT"
2 = "s_elev*"
1001 = "AcDbDynamicBlockTrueName"
1000 = "s_elev*"
Or is there another way?
-
This is a work around. You get a string of names from a function then use that for your filter.
Function SelectDynamicByName(sName As String) As String
Dim sArray As String
Dim oBref As AcadBlockReference
Dim SS As AcadSelectionSet
sArray = sName
Set SS = sset(2, "`*U*") 'Use a selectionset function
For Each oBref In SS
If oBref.IsDynamicBlock Then
If oBref.EffectiveName = sName Then
sArray = sArray & ",`" & oBref.Name
End If
End If
Next
SelectDynamicByName = sArray
End Function
Sub Test()
Dim SS As AcadSelectionSet
Set SS = sset(2, SelectDynamicByName("Door - Imperial"))
Debug.Print SS.count
End Sub
Public Function sset(FilterType, FilterData As Variant, Optional ssName As String = "SS") As AcadSelectionSet
Dim oSSets As AcadSelectionSets
Set oSSets = ThisDrawing.SelectionSets
For Each sset In oSSets
If sset.Name = ssName Then
sset.Delete
Exit For
End If
Next
Dim FType() As Integer
Dim FData() As Variant
Dim i As Integer
If IsArray(FilterType) = False Then
If IsArray(FilterData) = False Then
ReDim FType(0)
ReDim FData(0)
FType(0) = FilterType
FData(0) = FilterData
Else
Exit Function
End If
Else
If UBound(FilterType) <> UBound(FilterData) Then
Exit Function 'They must be pairs
End If
ReDim FType(UBound(FilterType))
ReDim FData(UBound(FilterType))
For i = 0 To UBound(FilterType)
FType(i) = FilterType(i)
FData(i) = FilterData(i)
Next
End If
Set sset = ThisDrawing.SelectionSets.Add(ssName)
sset.Select 5, FilterType:=FType, FilterData:=FData
'To use this function for single filter
'Set SS = SSet(0, "insert")
'For multiple filter
'Set SS = SSet(array(0,2),array("insert",oBlock.name)) 'must be pairs
End Function
End Sub
-
Bryco,
Thank you very much for the excellent work-around.
It does what I want.
I had tried something like that but didn't know about the ` character.
-
Glad it worked, I had to ask about that character as well, it's handy for a purge sub as dimension blocks need it too.