Nombre de messages : 253 Age : 38 Localisation : Belgique Emploi : Ingénieur Géomètre Expert Date d'inscription : 09/12/2006
Sujet: Re: Sélection par attributs Lun 26 Nov - 17:55
Code:
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
Ceci est un programme qui demande de faire une sélection, puis demande une valeur max et déplace vers un calque tous les points dont l'attribut code est inférieur à cette valeur.