ActiveX API - Layer Filter Manipulation

[ntaylor]

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


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

[RobertB]

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

[jwanstaett]

Here a class modules i use to work with Layer Filter

[ntaylor]

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

[jwanstaett]

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


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

[ntaylor]

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

:-D Nathan Taylor

[ntaylor]

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-*"


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.


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