VB code
Code:
Imports System.Collections.Generic
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Internal
Imports Autodesk.AutoCAD.Runtime
Namespace CountByVisibilityState
Public Class Commands
<CommandMethod("Test")> _
Public Sub Test()
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Dim result As Dictionary(Of String, Long) = GetCountByVisibility("ElecBaseboard", "Puissance plinthe")
For Each pair As KeyValuePair(Of String, Long) In result
ed.WriteMessage(vbLf & "{0} = {1}", pair.Key, pair.Value)
Next
End Sub
' Retourne un dictionnaire dont les clés sont les états de visibilité et la valeur
' le nombre de blocs correspondant dans la sélection.
Private Function GetCountByVisibility(blockName As String, propName As String) As Dictionary(Of String, Long)
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
' Valeur de retour
Dim result As New Dictionary(Of String, Long)()
' Sélection des blocs en fonction du nom effectif
Dim psr As PromptSelectionResult = ed.SelectBlockByName(blockName)
If psr.Status <> PromptStatus.OK Then
Return result
End If
Using tr As Transaction = db.TransactionManager.StartTransaction()
' Parcourir le jeu de sélection
For Each id As ObjectId In psr.Value.GetObjectIds()
' Ouverture du bloc en écriture
Dim br As BlockReference = DirectCast(tr.GetObject(id, OpenMode.ForRead), BlockReference)
' Parcourir la collection de propriétés dynamiques
For Each prop As DynamicBlockReferenceProperty In br.DynamicBlockReferencePropertyCollection
' Si le nom de la propriété correspond...
If prop.PropertyName.Equals(propName, StringComparison.CurrentCultureIgnoreCase) Then
' Valeur de la propriété (état de visiblité)
Dim state As String = DirectCast(prop.Value, String)
' Si le dictionnaire contient déjà cet état, on incrément le nombre
If result.ContainsKey(state) Then
result(state) += 1
Else
' Sinon, on ajoute une nouvelle entrée
result.Add(state, 1)
End If
End If
Next
Next
tr.Commit()
End Using
Return result
End Function
End Class
' Méthodes d'extension
Module Extensions
' Modèle pour le(s) nom(s) de bloc (accepte les caractères génériques)
Private _pattern As String
' Retourne le nom effectif du bloc
<System.Runtime.CompilerServices.Extension()> _
Public Function GetEffectiveName(br As BlockReference) As String
Return IIf(br.IsDynamicBlock, DirectCast(br.DynamicBlockTableRecord.GetObject(OpenMode.ForRead), BlockTableRecord).Name, br.Name)
End Function
' Retourne une instance de PromptSelectionResult en filtrant les blocs dont le nom effectif correspond au modèle.
<System.Runtime.CompilerServices.Extension()> _
Public Function SelectBlockByName(ed As Editor, pattern As String, ParamArray filter As TypedValue()) As PromptSelectionResult
_pattern = pattern
Dim psr As PromptSelectionResult = Nothing
Using tr As Transaction = ed.Document.TransactionManager.StartTransaction()
Try
' Abonnement à l'évènement SelectionAdded
AddHandler ed.SelectionAdded, New SelectionAddedEventHandler(AddressOf onSelectionAdded)
psr = ed.GetSelection(New SelectionFilter(filter))
Finally
' Désabonnement à l'évènement SelectionAdded
RemoveHandler ed.SelectionAdded, New SelectionAddedEventHandler(AddressOf onSelectionAdded)
End Try
End Using
Return psr
End Function
' Gestionnaire de l'évènnement SelectionAdded :
' supprime du jeu de sélection les blocs dont le nom ne correspond pas au modèle
Private Sub onSelectionAdded(sender As Object, e As SelectionAddedEventArgs)
Dim toRemove As New List(Of Integer)()
Dim ss As SelectionSet = e.AddedObjects
For i As Integer = 0 To ss.Count - 1
' Si l'objet sélectionné n'est pas un bloc, il est supprimé du jeu de sélection
If ss(i).ObjectId.ObjectClass.DxfName <> "INSERT" Then
toRemove.Add(i)
Continue For
End If
Dim br As BlockReference = DirectCast(ss(i).ObjectId.GetObject(OpenMode.ForRead), BlockReference)
' Si le nom effectif du bloc ne correspond pas au modèle, il est supprimé du jeu de sélection
If Not Utils.WcMatch(br.GetEffectiveName().ToUpper(), _pattern.ToUpper()) Then
toRemove.Add(i)
End If
Next
For Each i As Integer In toRemove
e.Remove(i)
Next
End Sub
End Module
End Namespace