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.

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