ActiveX API - Layer Filter Manipulation

I have some VBA code that can delete all layer filters through manipulating the dictionaries collection but I have no idea how to get the filter information or create new filters. It would be a lot simpler if Layer Filters were in the API.

Regards - Nathan

Code:

---

Public Sub RemoveAutoCADLayerFilters()
Dim objDict As AcadDictionary
Dim objDict1 As AcadDictionary
Dim varFilter As Variant
If ThisDrawing.Layers.HasExtensionDictionary = True Then
    Set objDict = ThisDrawing.Layers.GetExtensionDictionary
    On Error GoTo ErrorHandler
    Set objDict1 = objDict.Item("ACAD_LAYERFILTERS")
    On Error GoTo 0
    For Each varFilter In objDict1
        varFilter.Delete
    Next varFilter
End If
ErrorHandler:
End Sub

---

Also, the API needs to include a way to make a filter active, and to invert it.

Here a class modules i use to work with Layer Filter

Quote:

---

Originally Posted by jwanstaett

Here a class modules i use to work with Layer Filter

---

I haven't got time to look at it in to much depth at the moment. Would you mind giving an overview of what it can do. I specifically am interested in how I can create my own filters.

Regards - Nathan

Quote:

---

Originally Posted by ntaylor

I haven't got time to look at it in to much depth at the moment. Would you mind giving an overview of what it can do. I specifically am interested in how I can create my own filters.

Regards - Nathan

---

Code:

---

Properties                Type
FilterName                String
          Set to the name of the Filter you are working with
          note: if no matching filter name it will be add
          to the list of filters

FilterLayerState  LayerState
          The Filer for layer State
          exp:  Filter.FilterLayerState = LayerOn + LayerFreeze
          will set the file for layers On and Freez3

 
Enum LayerState
          LayerOn = 1
          LayerOff = 3
          LayerFreeze = 4
          LayerThaw = 12
          CurrentVpFreeze = 16
          CurrentVpThaw = 48
          NewVpFreeze = 64
          NewVpThaw = 192
          LayerLock = 256
          LayerUnLock = 768
          PlotYes = 1024
          PlotNo = 3072
  End Enum

FilterLayers          String
                                  The name of the layer to filer
                                  exp: Filter.FilterLayers = "mylyers"

FilterColor          String
                                 
FilterLineType        string
FilterLineWeight  String
FilterPlotStyle  String
Methods
GetFilterList  Return a Array of string with the name of
                                                Layer Filters
                       
RemoveFilter  Remover the Layer Filter Named
                          exp: Filter.RemoveFilter "myfilter"
                                  will remove the filter name myfilter
                          note: will not remove filter if Filter.FilterName = "myfilter" 
LayerStateMast or use With LayerState
Enum LayerStateMast
        LayerOnoff = 3
        LayerFreezeThaw = 12
        CurrentVpFreezeThaw = 48
        NewVpFreezeThaw = 192
        LayerLockUnLock = 768
        PlotYesNo = 3072
End Enum
exp: If LayerStateMast.LayerOnoff and Filter.FilterLayerState = LayerState.LayerOn then
                msgBox "Layer on"
          End If

---

Thanks a lot, I've worked out what I should be able to do now.

:-D Nathan Taylor

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

---