I posted this in the Autodesk newgroup without any luck.
Does anyone know how to create nested layer property filters in 2005 with VBA?
I have worked out how to create new filters without nesting and how to delete all filters including nested filters.
Regards - Nathan
Following code creates a filter named "TEXT" filtering for layers named "T-*"
Code:
Public Sub AddLayerFilters()
Dim objDict As AcadDictionary
Dim objFilter As AcadXRecord
Dim intXRDType(6) As Integer
Dim varXRDValue(6) As Variant
Set objDict = ThisDrawing.Layers.GetExtensionDictionary.AddObject("ACAD_LAYERFILTERS", "AcDbDictionary")
Set objFilter = objDict.AddXRecord("TEXT")
intXRDType(0) = 1: varXRDValue(0) = "TEXT"
intXRDType(1) = 1: varXRDValue(1) = "T-*"
intXRDType(2) = 1: varXRDValue(2) = "*"
intXRDType(3) = 1: varXRDValue(3) = "*"
intXRDType(4) = 70: varXRDValue(4) = 0
intXRDType(5) = 1: varXRDValue(5) = "*"
intXRDType(6) = 1: varXRDValue(6) = "*"
objFilter.SetXRecordData intXRDType, varXRDValue
End Sub
Following code removes all filters including nested filters.
Code:
Public Sub RemoveLayerFilters()
Dim blnError As Boolean
Dim objDict As AcadDictionary
Dim objFilter As AcadXRecord
blnError = False
On Error GoTo ErrorHandler
Set objDict = ThisDrawing.Layers.GetExtensionDictionary.Item("AcLyDictionary")
On Error GoTo 0
If blnError = False Then
For Each objFilter In objDict
objFilter.Delete
Next objFilter
End If
blnError = False
On Error GoTo ErrorHandler
Set objDict = ThisDrawing.Layers.GetExtensionDictionary.Item("ACAD_LAYERFILTERS")
On Error GoTo 0
If blnError = False Then
For Each objFilter In objDict
objFilter.Delete
Next objFilter
End If
Exit Sub
ErrorHandler:
blnError = True
Resume Next
End Sub