Sélectionner un bloc dynamique

rrobert · le 8 juin 2021

VBA

Je me bats depuis plusieurs jours...

Je souhaite sélectionner tous les blocs dynamiques de mon dessin ayant le nom "test".

J'utilise jusqu'ici la méthode suivante (je vous passe la déclaration des variables) :

Quote

nom_bloc="test"

Set selection = ThisDrawing.SelectionSets.Add("test01")
selection.Select acSelectionSetAll

For Each objet In selection
With objet
If .EntityName = "AcDbBlockReference" Then
If .Name = nom_bloc Then

'Traitement des blocs

End If
End If
End With
Next

Le problème c'est qu'avec les blocs dynamiques, tous mes blocs "test" ont en fait un nom différent (*Uxx). Normal car ce sont des blocs dynamiques.

Mais est-il possible de tester le nom "générique" du bloc plutôt que son nom *Uxx ?

J'ai essayé une autre méthode, mais cette dernière ne détecte pas les blocs dynamiques, seulement les blocs normaux :

Quote

Sub selectABlock()

Dim sset As AcadSelectionSet
Set sset = ThisDrawing.SelectionSets.Add("test02")

Dim filterType As Variant
Dim filterData As Variant
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double

Dim grpCode(0) As Integer
grpCode(0) = 2
filterType = grpCode
Dim grpValue(0) As Variant
grpValue(0) = "test"
filterData = grpValue

sset.Select acSelectionSetAll, p1, p2, filterType, filterData

MsgBox ("Elements filtrés: " & str(sset.Count))

sset.Delete

End Sub

Le problème c'est que je n'arrive pas à trouver les codes DXF me permettant de renseigner la bonne valeur pour filterType et filterData...

Bref, je cherche une méthode permettant de sélectionner des blocs dynamiques avec plusieurs possibilités de filtres 😉

Merci pour vos aides,

Rémi

(gile) · le 8 juin 2021

Salut,

Sujet moultes fois traité en LISP.
On ne peut pas filtrer directement (avec un filtre de sélection) les blocs dynamiques par leur noms.
Généralement on filtre avec le nom du bloc de base (pour les référence dont les propriétés dynamiques n'ont pas été changées) et tous les noms commençant par *U (références de bloc anonymes). Puis on traite la sélection en vérifiant la propriété EffectiveName.

Pour filtrer la sélection :

   Dim filterType As Variant
   Dim filterData As Variant
  
   Dim grpCode(0) As Integer
   grpCode(0) = 0
   Dim grpCode(1) As Integer
   grpCode(0) = 2
   filterType = grpCode
   Dim grpValue(0) As Variant
   grpValue(0) = "INSERT"
   Dim grpValue(1) As Variant
   grpValue(1) = "test,`*U*"
   filterData = grpValue

Pour traiter le jeu de sélection :

For Each objet In selection
    If objet.EffectiveName = nom_bloc Then

        'Traitement des blocs

     End If
Next

Luna · le 8 juin 2021

Coucou,

Je n'ai pas de connaissance VBA, mais en LISP ce doit être le même principe. Pour commencer, le code DXF 2 pour une référence de bloc correspond au nom de la référence (donc pour un bloc standard c'est le nom de la définition de bloc, mais pour un bloc dynamique c'est "*U..."). Autrement dit, il n'y a pas de possibilité (du moins en LISP) de filtrer un bloc dynamique au moment de la sélection via le nom de la définition (car ce nom n'apparaît pas dans la liste DXF). Donc on applique le filtre de sélection en post-sélection via une boucle. Pour cela, il suffit de filtrer la sélection sur le nom de la définition de bloc et on ajoute la chaîne "`*U*" pour sélectionner toutes les références dynamiques.
Puis dans une boucle on vérifie chaque entité sélectionnée via la propriété "EffectiveName" (en visual, donc VBA) ou "BlockTableRecord/Name" (en LISP via (getpropertyvalue)). Donc je pense que ce que tu recherches, c'est la propriété EffectiveName mais je ne sais pas si tu peux filtrer ta sélection directement sur cette propriété ou bien si tu dois également faire une boucle pour affiner la sélection.
Et dernière chose, il faut savoir que les entités RESEAUX (Array) sont également définies comme des blocs dynamiques sauf qu'elles ne possèdent pas de propriétés EffectiveName (elles ne sont pas rattachées à une définition de bloc connue), donc en LISP il faut également vérifier que le bloc dynamique n'est pas un réseau sous peine d'avoir une erreur lors de la vérification du nom du bloc dynamique.

Evidemment, cette méthode de post-sélection est très ennuyeuse car plus le .dwg contient de blocs dynamiques et plus le traitement pour filtrer les blocs dynamiques est long car on est obligé de sélectionner toutes les références de blocs dynamiques.

EDIT: @(gile) a été encore une fois plus rapide et concis ! :3

Bisous,
Luna

Modifié le 8 juin 2021 par Luna

(gile) · le 8 juin 2021

1 minute ago, Luna said:

EDIT: @(gile) a été encore une fois plus rapide et concis ! :3

Tu as été plus exhaustive.

Curlygoth · le 8 juin 2021

Et du coup : Tu veux les sélectionner (comme on sélectionne des objets dans un dessin ) ou juste avoir un jeu de sélection via code ?

Sinon la méthode de (gile) est la mieux en efficacité !

et pour gérer les paramètre des bloc dynamique :

où 
set objet = blockRefObj 'pour adapter avec le code de (gile)

dybprop = blockRefObj.GetDynamicBlockProperties
For i = LBound(dybprop) To UBound(dybprop)
    If dybprop(i).PropertyName = "NOM_VAR_DYN" Then 'code pour gérer suivant le nom des propriété dynamique
	if dybprop(i).Value = VAR then 'code pour gérer les blocs avec une valeur


next i

rrobert · le 8 juin 2021

EffectiveName, merci !!

Cela confirme mes doutes, on est donc très limité dans le filtrage pré-sélection et il faut forcément passer par une évaluation de tous les objets d'une sélection plus large !

Merci pour ces retours.

@Curlygoth si je ne me trompe pas, une sélection simple permet un traitement sans historique alors qu'un jeu de sélection conservera toujours les objets sélectionnés dedans?

Comment supprimer un objet d'un jeu de sélection?

rrobert · le 8 juin 2021

@Curlygoth je risque certainement d'avoir des sélections toujours éphémères, je suppose qu'il y a une méthode de sélection plus adaptée que créer un SelectionSet ?

Curlygoth · le 8 juin 2021

Tu ne te trompe pas ;-)

ça dépend de ce que tu veux en faire 😉

et tu peux toujours vider ta "selection" pour le re-remplir ou créer une autre "table" ou créer une selection01 et il mettre les entity que tu veux garder pour filtrer ton traitement final

PS : Personnellement, je fais une méthode moins efficace que la méthode de (Gile) et je parcours TOUS mes objets de mon dessin pour les filtrer moi même et agir directement dessus

c'est plus long mais vu que je fais un traitement complet c'est plus pratique pour moi

rrobert · le 8 juin 2021

@Curlygoth je risque certainement d'avoir des sélections toujours éphémères, je suppose qu'il y a une méthode de sélection plus adaptée que créer un SelectionSet ?

Je pense aussi tout sélectionner puis filtrer après du coup 😉

rrobert · le 8 juin 2021

Je me casse la tête depuis 3h.....

Ma Sub actuelle permet de :

- sélectionner un bloc dans mon plan

- Sélectionner tous les blocs du même nom étant au même étage (les étages étant définis par un écartement fixe stocké dans USERI1)

EX : pour USERI1=50, le RDC est situé entre 0 et 50m, le R+1 entre 50 et 100m, etc. Les étages négatifs sont pris en compte.

Sauf que voilà....

Je n'arrive pas à comprendre la sélection alors que le code ne me paraît pas trop foireux.. (probablement pas optimisé, certes)

Le code :

Quote

Sub selectionner_etage()
'Cette macro permet de sélectionner un bloc manuellement puis de sélectionner tous les blocs du même nom présents sur le même étage

Dim etage_recherche As Integer
Dim etage_ref As Integer
Dim espacement_etage As Double
Dim lim_inf As Double
Dim lim_sup As Double
Dim viewpoint As Variant

'Variables pour la sélection d'objet
Dim selectionref As AcadEntity
Dim point_selection_ref As Variant
Dim blocref As AcadBlockReference
Dim nom_bloc As String

Dim selection As AcadSelectionSet
Dim objet As AcadObject
Dim objet_suppr(0) As AcadEntity
Dim bloc As AcadBlockReference
Dim bloc_sel As AcadBlockReference

Dim i As Integer

'on vient récupérer les variables Autocad nécessaire à la réalisation de la macro
viewpoint = ThisDrawing.GetVariable("viewctr")
espacement_etage = ThisDrawing.GetVariable("useri1")

'On calcule l'étage auquel se trouve l'objet en regardant où se trouve le Y de son point d'insertion

'L'utilisateur doit sélectionner UN bloc de référence
'Si la sélection comporte une erreur on recommence la phase de sélection
On Error Resume Next
RETRY:
'Code de sélection du bloc de référence
ThisDrawing.Utility.GetEntity selectionref, point_selection_ref, vbCr & "Sélectionnez le bloc de référence"
'verification des erreurs de selection
If Err <> 0 Then
Err.Clear
MsgBox "La sélection est vide ou non valide."
GoTo RETRY
End If

'On vérifie que l'élément de référence sélectionné est un bloc
If TypeOf selectionref Is AcadBlockReference Then
Set blocref = selectionref
nom_bloc = blocref.EffectiveName
'On détermine le niveau du bloc ainsi que les limites sup et inf du niveau
'ATTENTION, ceci ne fonctionne qu'avec les coordonnées du SCG
If blocref.InsertionPoint(1) >= 0 Then
etage_ref = Fix((blocref.InsertionPoint(1)) / espacement_etage)
Else
etage_ref = Fix((blocref.InsertionPoint(1)) / espacement_etage) - 1
End If
lim_sup = espacement_etage * (etage_ref + 1)
lim_inf = espacement_etage * etage_ref

'MsgBox "Nom du bloc : " & nom_bloc
'MsgBox "Point d'insertion (1) : " & blocref.InsertionPoint(1)
'MsgBox "Etage ref : " & etage_ref
'MsgBox "Lim inf : " & lim_inf
'MsgBox "Lim sup : " & lim_sup
Else
MsgBox "L'élément sélectionné n'est pas un bloc."
GoTo RETRY
End If

'On sélectionne tous les objets du plan
Set selection = ThisDrawing.SelectionSets.Add("test01")
selection.Select acSelectionSetAll
MsgBox ("Elements sélectionnés: " & str(selection.Count))

'On Parcourt chaque objet de la sélection
For Each objet In selection
Set objet_suppr(0) = objet
'On vérifie que l'objet est un bloc
If TypeOf objet Is AcadBlockReference Then
Set bloc_sel = objet
With bloc_sel

'On vérifie si le bloc sélectionné a le même nom que le bloc de référence
If .EffectiveName = nom_bloc Then
'MsgBox (.InsertionPoint(1))

'On vérifie si le bloc est au même étage que le bloc de référence
If .InsertionPoint(1) > lim_inf And .InsertionPoint(1) < lim_sup Then
'MsgBox (.EffectiveName)
objet.Highlight True
Else
selection.RemoveItems (objet_suppr)
End If
Else
selection.RemoveItems (objet_suppr)
End If
End With
Else
selection.RemoveItems (objet_suppr)
End If
Next
'selection.Update
MsgBox ("Elements sélectionnés après filtrage: " & str(selection.Count))
'selection.Highlight True
selection.Delete

End Sub

Je ne comprends pas trop comment RemoveItems fonctionne....

Si je supprime les lignes RemoveItems, je n'ai pas de souci, ça fonctionne bien !

Sinon il me sort une sélection au hasard, avec des objets en highlight qui ne correspondent pas au nombre d'objets restants dans la sélection.

Curlygoth · le 8 juin 2021

ok et plutot que tu tout sélectionner puis enlever pourquioi tu n'essairais pas l'inverse ?

Sélectionner tes blocs entre tes Deux valeur de Y ?

rrobert · le 9 juin 2021

L'idée est très bonne mais comment faire?

Créer un jeu de sélection vide, parcourir tous les blocs du dessin et l'ajouter s'il correspond aux conditions?

Curlygoth · le 9 juin 2021

yes ^^

didier · le 9 juin 2021

Bonjour @rrobert

On parle sans savoir de quoi il s'agit, merci de faire passer un dessin pour qu'on discute de la même chose.
Le code concerné devra être déposé aussi pour pas qu'on à reprendre depuis le début.
Je reviens sur cette façon de dessiner les étages qui reste une fausse bonne idée, des préfixes dans les calques facilitent bien plus la vie.

Autre chose :
Merci de faire attention à la mise en page des messages, il y a beaucoup trop de sauts de lignes et ça rend la lecture bien compliquée.

Amicalement

(gile) · le 9 juin 2021

Salut,

@rrobert, concernant la mise en page, il serait préférable d'utiliser la bonne balise quand tu postes du code ( <> au lieu de ").

Sinon, as-tu vraiment besoin d'un jeu de sélection ? Ne peux-tu pas plutôt utiliser une Collection pour les blocs concernés ?

Curlygoth · le 9 juin 2021

Quote

Sinon, as-tu vraiment besoin d'un jeu de sélection ? Ne peux-tu pas plutôt utiliser une Collection pour les blocs concernés ?

Moi je veux savoir ce qu'il en fait une fois dans sa sélection justement ^^'

rrobert · le 9 juin 2021

Au temps pour moi !

Voici la macro complète:

Sub selectionner_etage()
'Cette macro permet de sélectionner un bloc manuellement puis de sélectionner tous les blocs du même nom présents sur le même étage
' Elle évoluera dans le temps pour créer un utilitaire de sélection complet permettant de renseigner les calques, noms, visibilité, attributs, dimensions, etc.

Dim etage_recherche As Integer
Dim etage_ref As Integer
Dim espacement_etage As Double
Dim lim_inf As Double
Dim lim_sup As Double
Dim viewpoint As Variant

'Variables pour la sélection d'objet
Dim selectionref As AcadEntity
Dim point_selection_ref As Variant
Dim blocref As AcadBlockReference
Dim nom_bloc As String

Dim selection As AcadSelectionSet
Dim objet As AcadObject
Dim objet_suppr(0) As AcadEntity
Dim bloc As AcadBlockReference
Dim bloc_sel As AcadBlockReference



'on vient récupérer les variables Autocad nécessaire à la réalisation de la macro
espacement_etage = ThisDrawing.GetVariable("useri1")


'L'utilisateur doit sélectionner UN bloc de référence
'Si la sélection comporte une erreur on recommence la phase de sélection
On Error Resume Next
RETRY:
'Code de sélection du bloc de référence
ThisDrawing.Utility.GetEntity selectionref, point_selection_ref, vbCr & "Sélectionnez le bloc de référence"
'verification des erreurs de selection
If Err <> 0 Then
    Err.Clear
    MsgBox "La sélection est vide ou non valide."
    GoTo RETRY
End If


'On vérifie que l'élément de référence sélectionné est un bloc
If TypeOf selectionref Is AcadBlockReference Then
    Set blocref = selectionref
    nom_bloc = blocref.EffectiveName
    'On détermine le niveau du bloc ainsi que les limites sup et inf du niveau
    'ATTENTION, ceci ne fonctionne qu'avec les coordonnées du SCG
    If blocref.InsertionPoint(1) >= 0 Then
        etage_ref = Fix((blocref.InsertionPoint(1)) / espacement_etage)
    Else
        etage_ref = Fix((blocref.InsertionPoint(1)) / espacement_etage) - 1
    End If
    lim_sup = espacement_etage * (etage_ref + 1)
    lim_inf = espacement_etage * etage_ref
    
    'MsgBox "Nom du bloc : " & nom_bloc
    'MsgBox "Point d'insertion (1) : " & blocref.InsertionPoint(1)
    'MsgBox "Etage ref : " & etage_ref
    'MsgBox "Lim inf : " & lim_inf
    'MsgBox "Lim sup : " & lim_sup
Else
    MsgBox "L'élément sélectionné n'est pas un bloc."
    GoTo RETRY
End If

'On sélectionne tous les objets du plan
Set selection = ThisDrawing.SelectionSets.Add("test01")
selection.Select acSelectionSetAll
MsgBox ("Elements sélectionnés: " & str(selection.Count))

'On Parcourt chaque objet de la sélection
For Each objet In selection
    Set objet_suppr(0) = objet
    'On vérifie que l'objet est un bloc
    If TypeOf objet Is AcadBlockReference Then
        Set bloc_sel = objet
        With bloc_sel
            
            'On vérifie si le bloc sélectionné a le même nom que le bloc de référence
            If .EffectiveName = nom_bloc Then
                'MsgBox (.InsertionPoint(1))
                'On vérifie que le bloc est au même niveau que le bloc de référence
                If .InsertionPoint(1) > lim_inf And .InsertionPoint(1) < lim_sup Then
                    'MsgBox (.EffectiveName)
                    objet.Highlight True
                Else
                    selection.RemoveItems (objet_suppr)
                    Set objet_suppr(0) = Nothing
                End If
            Else
                selection.RemoveItems (objet_suppr)
                Set objet_suppr(0) = Nothing
            End If
        End With
    Else
        selection.RemoveItems (objet_suppr)
        Set objet_suppr(0) = Nothing
    End If
    Set objet_suppr(0) = Nothing
Next
Set objet_suppr(0) = Nothing
'selection.Update
MsgBox ("Elements sélectionnés après filtrage: " & str(selection.Count))
'selection.Highlight True
selection.Delete

End Sub

Le fichier est trop lourd pour passer en PJ... 😕

Une collection, what? Jamais entendu parler de ça.

Luna · le 9 juin 2021

Coucou,

20 hours ago, (gile) said:

Dim filterType As Variant
Dim filterData As Variant
Dim grpCode(0) As Integer
grpCode(0) = 0
Dim grpCode(1) As Integer
grpCode(0) = 2
filterType = grpCode
Dim grpValue(0) As Variant
grpValue(0) = "INSERT"
Dim grpValue(1) As Variant
grpValue(1) = "test,`*U*"
filterData = grpValue

Je ne connais rien en VBA mais j'avoue ne vraiment pas comprendre l'intérêt de filtrer les objets uniquement en post-sélection....

19 hours ago, rrobert said:

Cela confirme mes doutes, on est donc très limité dans le filtrage pré-sélection et il faut forcément passer par une évaluation de tous les objets d'une sélection plus large !

Au vu de l'exemple de @(gile), je dirais que les possibilité de filtre sont similaires aux filtres (ssget). Autrement dit, on est vraiment pas limité dans le filtrage de la sélection !! Il arrive assez souvent que l'on soit obligé de faire un second filtrage plus spécifique dans une boucle, mais rien n'empêche de réduire le nombre d'objets à traiter...Il y a une très grande différence entre devoir traiter 150 000 objets ou seulement 150 si les filtres sont bien définis...

Ici, tu veux sélectionner tous les blocs de même nom et appartenant au même étage. Il est tout-à-fait possible de réaliser cette sélection en filtrant la sélection du premier coup...Le seul élément qui pose problème ici, c'est le mot "bloc". Car les blocs dynamiques ne possède pas leur EffectiveName directement dans la liste DXF donc il y a besoin d'une boucle de post-sélection, mais si tu ne voulais t'occuper que de blocs standards, tu n'aurais même pas besoin de faire une boucle théoriquement.

Donc chat me chiffonne un peu d'entendre dire que les filtres de sélection sont très limités, car c'est faux. Mais bon après il ne s'agit là que d'un simple conseil, pour éviter d'avoir un programme qui tourne pendant 2h :3

Bisous,
Luna

(gile) · le 9 juin 2021

3 minutes ago, rrobert said:

Une collection, what? Jamais entendu parler de ça.

Objet Collection, moi je ne fais pas de VBA...

didier · le 9 juin 2021

Bonjour @rrobert

Un extrait du fichier serait une bonne idée, je suis surpris qu'un dessin ne passe pas sur le site, combien pèse-t-il ?

Ce serait bien d'avoir au moins deux étages pour pouvoir tester in situ

Amicalement

Curlygoth · le 9 juin 2021

Pour revenir à l'ajout à une sélection :

selection.AddItems objet_new

et

set objet_new = ton objet 😉

rrobert · le 9 juin 2021

Merci pour tous vos retours, je vais regarder ça (préfiltrage et collections).

@didier le fichier fait 105 ko et la PJ est limitée à 47 kb :

(gile) · le 9 juin 2021

C'est ça que tu veux faire ?

(defun c:test  (/ b n u e s i)
  (while
    (not
      (and
	(setq b (car (entsel "\nSélectionnez le bloc de référence: ")))
	(= (cdr (assoc 0 (entget b))) "INSERT")))
     (prompt "\nLa sélection est vide ou non valide."))
  (setq	n (getpropertyvalue b "BlockTableRecord/Name")
	u (getvar 'useri1)
	e (/ (fix (cadr (getpropertyvalue b "Position"))) u))
  (if (setq s (ssget "_X"
		   (list
		     (cons 0 "INSERT")
		     (cons 2 (strcat n ",`*U*"))
		     (cons -4 "*,>=,*")
		     (cons 10 (list 0. (* e u) 0.))
		     (cons -4 "*,<,*")
		     (cons 10 (list 0. (* (1+ e) u) 0.)))))
  (repeat (setq i (sslength s))
    (setq b (ssname s (setq i (1- i))))
    (if	(/= (getpropertyvalue b "BlockTableRecord/Name") n)
      (ssdel b s))))
  (sssetfirst nil s)
  (princ))

rrobert · le 9 juin 2021

@gile c'est exactement ça !

Je sais, je sais, le lisp est plus puissant et mieux, mais la syntaxe n'est pas évidente au début, et connaissant déjà le VBA je trouvais ça plus facile de me lancer avec le VBA. D'autant qu'avec les userForm il est facile de créer des choix de sélections, bref je trouve cela plus personnalisable !

(gile) · le 9 juin 2021

4 minutes ago, rrobert said:

Je sais, je sais, le lisp est plus puissant et mieux

Non, le LISP n'est pas plus puissant ou mieux, il est juste mieux intégré et plus concis.
C'était juste pour être sûr de ce que tu voulais faire et te montrer qu'on peut tout filtrer excepté le nom effectif des blocs anonymes.

Le filtre en VBA devrait être quelque chose comme ça :

Dim pointMin() As Double = Array(0.0, lim_inf, 0.0) 
Dim pointMax() As Double = Array(0.0, lim_sup, 0.0) 
Dim filterType As Variant = Array(0, 2, -4, 10, -4, 10)
Dim filterData As Variant = Array("INSERT", nom_bloc & ",`*U*", "*,>=,*", pointMin, "*,<,*", pointMax)

Sélectionner un bloc dynamique

Messages recommandés

Meilleurs contributeurs dans ce sujet

Jours populaires

Meilleurs contributeurs dans ce sujet

Jours populaires

Messages populaires

(gile)

(gile)

Luna

Images postées

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante