The following example defines property alteration for a query. The property alteration uses a range table. To run the example again, clear the query and clear the list of expressions for alterations.
Sub altermap()
Dim amap As AcadMap
Dim prj As Project
Dim qry As Query
Dim mainqrybr As QueryBranch
Dim qrylf As QueryLeaf
Dim propqrylf As QueryLeaf
Dim dataqrylf As QueryLeaf
Dim andqrybr As QueryBranch
Dim mapu As MapUtil
Dim wind As WindowBound
Dim boolVal As Boolean
Dim atdr As AttachedDrawing
Dim dblary As Variant
Dim altls As AlterLines
Dim altl As Variant
Dim txtdf As TextDef
Dim rngtb As RangeTable
Dim rng As Range
Dim altlLay As AlterLine
Dim lay As AcadLayer
'Get AutoCAD Map and Project Objects
Set amap = ThisDrawing.Application. _
GetInterfaceObject("AutoCADMap.Application")
Set prj = amap.Projects(ThisDrawing)
'Get Current Query
Set qry = prj.CurrQuery
qry.Clear
'Attach DWG
Set atdr = prj.DrawingSet.Add("MAPTUT:\\citymap7.dwg")
'Get Main Branch
Set mainqrybr = qry.QueryBranch
'Create Layout of Leaves and Branch
Set qrylf = mainqrybr.Add(kLocationCondition, kOperatorAnd)
Set andqrybr = mainqrybr.Add(kQueryBranch, kOperatorAnd)
Set propqrylf = andqrybr.Add(kPropertyCondition, kOperatorOr)
Set dataqrylf = andqrybr.Add(kDataCondition, kOperatorOr)
'Get DWG Extents
dblary = prj.DrawingSet.Item("MAPTUT:\\citymap7.dwg").Extents
'Define Boundary Area for Location
Set mapu = prj.MapUtil
Set wind = mapu.NewWindow( _
mapu.NewPoint3d(dblary(0), dblary(1), 0), _
mapu.NewPoint3d(dblary(2), dblary(3), 0))
'Complete Leaves
boolVal = qrylf.SetLocationCond(kLocationInside, wind)
boolVal = propqrylf.SetPropertyCond(kLayer, kCondEq, "Stream")
boolVal = dataqrylf.SetDataCond( _
kDataIRD, _
kCondLT, _
"Water_Bodies", _
"Avg_Depth", _
10)
'Specify Draw Query
qry.Mode = kQueryDraw
'Alter Color and Annotate
Set altls = qry.AlterProp
altls.RemoveAll
Set altl = altls.Add(kAlterationColor, "RED")
Set txtdf = altls.Add( _
kAlterationTextEntity, _
":NAME@WATER_BODIES")
qry.AlterTag = True
'Create MARSH Layer
Set lay = ThisDrawing.Layers.Add("MARSH")
'Alter Layer Based on Range Table
prj.RangeTables.Remove ("foulwater")
Set rngtb = prj.RangeTables.Add("foulwater", "shallow water")
Set rng = rngtb.Add("10", "MARSH", kRangeLT)
Set altlLay = prj.CurrQuery.AlterProp.Add( _
kAlterationLayer, _
"(Range :AVG_DEPTH@WATER_BODIES foulwater)")
'Define Query
boolVal = qry.Define(mainqrybr)
'Execute Query
boolVal = qry.Execute
ThisDrawing.Application.ZoomExtents
End Sub