Public Sub FiltrePts()
  Dim I, j As Integer
  Dim Entity As AcadEntity
  Dim BlocRef As AcadBlockReference
  Dim Attributes As Variant
  Dim S As String
  Dim BaSelect As AcadSelectionSet
 

 
                             
    ' Creation du jeu de selection
    Set BaSelect = ThisDrawing.SelectionSets.Add("hgf44522221221545545dghf")
   
    'Selection des entites
    Call BaSelect.SelectOnScreen

    ' Introduction de la valeur limite
    limite = CDbl(InputBox("Valeur ?"))
 
  ' Creation du calque
    ThisDrawing.Layers.Add ("Points filtrés " & CStr(limite))
   
  ' On parcourt tous les objets de l'espace objet
    For I = 0 To BaSelect.Count - 1
    Set Entity = BaSelect.Item(I)
   
    ' Si l'objet est une insertion de bloc
    If Entity.ObjectName = "AcDbBlockReference" Then
      ' On précise le type de l'objet pour pouvoir accéder à ses propriétés et
      ' ses méthodes spécifiques
      Set BlocRef = Entity
     
     
      ' Si il a des attributs
      If BlocRef.HasAttributes Then
       
        ' On les récupére
        Attributes = BlocRef.GetAttributes
       
        If UBound(Attributes) = 2 Then
       
            If CDbl(Attributes(2).TextString) < limite Then
               
                BlocRef.Layer = "Points filtrés " & CStr(limite)
               
            End If
               
        End If
               
      End If
     
    End If
  Next
 
BaSelect.Delete
End Sub