Select and zoom the elements

Hi All,

I want to zoom the first element which is in the Level Number "3". Below is my code

Private Sub GettingElement()
On Error Resume Next

Dim elem As Element
Dim ElemEnum As ElementEnumerator
Dim elemScanCriteria As ElementScanCriteria
Dim rng As Range3d
Dim oLevels As Levels
Dim oLevel As Level
Set elemScanCriteria = New ElementScanCriteria
elemScanCriteria.IncludeLevel oLevel
Set oLevels = ActiveDesignFile.Levels
Set oLevel = oLevels.FindByNumber(3)
Set ElemEnum = ActiveModelReference.Scan(elemScanCriteria)
ElemEnum.MoveNext
Set elem = ElemEnum.Current
If elem.Level.Number = 3 Then
Call SelectedElement()
End If

Set ElemEnum = Nothing
MsgBox ("Process Completed")


End Sub


Public Sub SelectedElement()
Dim oEnumerator As ElementEnumerator
Set oEnumerator = ActiveModelReference.GetSelectedElements


Do While oEnumerator.MoveNext
Dim oElement As Element
Set oElement = oEnumerator.Current
Const Zoom As Double = 2
Dim range As Range3d
range = oElement.range
Dim oView As View
Set oView = ActiveDesignFile.Views.Item(1)
Dim extent As Point3d
extent = Point3dScale(Point3dSubtract(range.High, range.Low), Zoom)
oView.Origin = Point3dSubtract(range.Low, Point3dScale(extent, 0.5))
oView.Extents = extent
oView.Redraw
Loop

ActiveModelReference.UnselectAllElements
End Sub


If I manually select any element in the dgn and runs the above, it works fine.
But I want the routine to choose the element in the Level Number 3 and zoom it.

Could you please help me.