Sélectionner un bloc dynamique

[rrobert]

Bonjour @didier c'est exactement cela.

Pas de souci sur le délai, c'est déjà gentil de m'aider.

Je m'y attaque de nouveau aujourd'hui, mais en repartant de zéro, j'espère trouver une solution !

 

@Luna je pensais également que c'était aussi simple que ce genre de code, mais ça paraît plus complexe, vu que ça ne marche pas ^^

[Curlygoth]

Extrait de l'aide pour .additem 🙂 :

remarks :

Objects currently in the specified selection set remain in the selection set. To replace the objects in the selection set, clear the selection set using the Clear method, then add the objects.

 

Sub Example_AddItems()
    ' This example creates a selection set and several objects.
    ' It then adds the objects to the selection set.
    
    ' Create the new selection set
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SELECTIONSET")
    
    ' Create a Ray object in model space
    Dim rayObj As AcadRay
    Dim basePoint(0 To 2) As Double
    Dim SecondPoint(0 To 2) As Double
    basePoint(0) = 3#: basePoint(1) = 3#: basePoint(2) = 0#
    SecondPoint(0) = 1#: SecondPoint(1) = 3#: SecondPoint(2) = 0#
    Set rayObj = ThisDrawing.ModelSpace.AddRay(basePoint, SecondPoint)
    
    ' Create a polyline object in model space
    Dim plineObj As AcadLWPolyline
    Dim points(0 To 5) As Double
    points(0) = 3: points(1) = 7
    points(2) = 9: points(3) = 2
    points(4) = 3: points(5) = 5
    Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
    plineObj.Closed = True

    ' Create a line object in model space
    Dim lineObj As AcadLine
    Dim startPoint(0 To 2) As Double
    Dim endPoint(0 To 2) As Double
    startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
    endPoint(0) = 2: endPoint(1) = 2: endPoint(2) = 0
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    
    ' Create a circle object in model space
    Dim circObj As AcadCircle
    Dim centerPt(0 To 2) As Double
    Dim radius As Double
    centerPt(0) = 20: centerPt(1) = 30: centerPt(2) = 0
    radius = 3
    Set circObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)

    ' Create an ellipse object in model space
    Dim ellObj As AcadEllipse
    Dim majAxis(0 To 2) As Double
    Dim center(0 To 2) As Double
    Dim radRatio As Double
    center(0) = 5#: center(1) = 5#: center(2) = 0#
    majAxis(0) = 10: majAxis(1) = 20#: majAxis(2) = 0#
    radRatio = 0.3
    Set ellObj = ThisDrawing.ModelSpace.AddEllipse(center, majAxis, radRatio)

    ZoomAll
    
    ' Iterate through the model space collection.
    ' Collect the objects found into an array of objects
    ' to be added to the selection set.
    ReDim ssobjs(0 To ThisDrawing.ModelSpace.count - 1) As AcadEntity
    Dim I As Integer
    For I = 0 To ThisDrawing.ModelSpace.count - 1
        Set ssobjs(I) = ThisDrawing.ModelSpace.Item(I)
    Next
    
    ' Add the array of objects to the selection set
    ssetObj.AddItems ssobjs
    
    ThisDrawing.Regen acActiveViewport
    
End Sub

j'utilise ce principe pour ajouter des objet dans un groupe.. j'ai pas besoin de sléction pou les groupe c'est

.AppendItems 

 

[didier]

Bonjour @Curlygoth

Est-ce que tu peux donner un code fonctionnel pour le souci exprimé par @rrobert?
L'aide AutoCAD, on a tous la même... Mais l'aide à la question posée n'est pas concernée par ces extraits.
Pour l'instant la solution n'a pas été exprimée sur le site.

Je ne suis pas dans ma zone de confort avec le VBA, je me suis mis à m'en servir seulement pour mon site et pour répondre aux questions.
Merci d'avance.

Amicalement

[(gile)]

D'après ce que je comprends, le souci de @rrobert est dans le traitement du jeu de sélection.
Il semble que la question du filtre de sélection pour ne garder que les blocs dynamiques dans l'intervalle d'un étage soit (enfin) résolue.
Reste donc à supprimer de ce jeu de sélection les blocs anonymes dont la valeur de la propriété EffectiveName ne correspond pas à celle du bloc source. Donc de l'utilisation de la méthode RemoveItems (ssdel en LISP).

[Curlygoth]

la j'avouerais que je finalise mes dossiers au boulot :-s

donc a part aider un peu de loin... mais oui

mais pourquoi pas dès que j'aurais plus de temps

(Travaux maison, Prépa départ entreprise, reprise sport)

[didier]

Bonjour @rrobert

Bon ça y est, je me suis libéré de mes autres tâches et j'ai enfin pu regarder ce qui nous tracassait.

Je n'ai pas réussi à retirer des items d'un array, aussi je me suis rabattu sur la création d'un nouveau de sélection depuis un filtre fait dans le premier jeu de sélection.

Je demande une sélection de bloc "exemple", ce sera celui qui sera filtré in fine.
Je fais un premier jeu de sélection avec filtre qui localise en fonction de l'étage tous les blocs dynamiques, ensuite je boucle à l'intérieur de cet array pour trouver les blocs qui correspondent à l'exemple, je crée un nouveau filtre en fonction de la valeur "U" trouvée, et avec ce filtre je crée finalement le jeu de sélection qui est demandé par rrobert.
Je pense être dans le vrai, je me suis un peu enquiquiné avec les valeurs de U, en effet le bloc prend une nouvelle valeur de U quand un paramètre est modifié, si une copie du bloc est réalisée sans qu'on change de paramètre dans la copie, on aura deux blocs avec le même EffectiveName et le même Name (U*). Suis-je clair ?

Ne disposant pas du savoir universel (surtout en VBA) je suis friand de voir les autres réponses pour améliorer mon niveau bien bas.

Je pense qu'il est temps de savoir ce qu'il faut faire de ce jeu de sélection, car si ça se trouve on peut se passer de toutes ces pirouettes...

Amicalement

Sub Test2_rrobert()
  Dim jsFiltre1 As AcadSelectionSet
  Dim jsFiltre2 As AcadSelectionSet
  Dim SelRef  As AcadEntity
  Dim FilterType(1) As Integer
  Dim FilterData(1) As Variant
  Dim ptSel As Variant
  Dim Pt1(0 To 2) As Double
  Dim Pt2(0 To 2) As Double
  Dim nomBlocDyn As String
  Dim i As Integer
  Dim filtreU As String
  Dim blocRef As AcadBlockReference
  Dim etage As Integer
  etage = ThisDrawing.GetVariable("useri1")
  '---------------------------------
  ThisDrawing.Utility.GetEntity SelRef, ptSel, vbCr & "Sélectionnez le bloc de référence"
  nomBlocDyn = SelRef.EffectiveName & ",`*U*"
  Set jsFiltre1 = ThisDrawing.SelectionSets.Add("JS1")
  Set jsFiltre2 = ThisDrawing.SelectionSets.Add("JS2")
  FilterType(0) = 0
  FilterData(0) = "INSERT"
  FilterType(1) = 2
  FilterData(1) = nomBlocDyn
  Pt1(0) = 0#:   Pt1(1) = etage:   Pt1(2) = 0#
  Pt2(0) = etage:    Pt2(1) = etage + 49.99:   Pt2(2) = 0#
  jsFiltre1.Select acSelectionSetWindow, Pt1, Pt2, FilterType, FilterData
  nomBlocDyn = SelRef.EffectiveName
  For Each blocRef In jsFiltre1
        If blocRef.IsDynamicBlock Then
            If blocRef.EffectiveName = nomBlocDyn Then
                filtreU = filtreU & ",`" & blocRef.name
           End If
        End If
    Next
    filtreU = nomBlocDyn & filtreU
   FilterData(1) = filtreU
  jsFiltre2.Select acSelectionSetWindow, Pt1, Pt2, FilterType, FilterData
   jsFiltre2.Highlight (True)
   Select Case jsFiltre2.Count
   Case 0
   MsgBox "Aucun bloc trouvé"
   Case 1
   MsgBox jsFiltre2.Count & " bloc trouvé"
   Case Is > 1
   MsgBox jsFiltre2.Count & " blocs trouvés"
   End Select
  jsFiltre1.Delete
  jsFiltre2.Delete
End Sub

 

[rrobert]

Bonjour @didier, merci pour cette immense aide. Cela fonctionne en effet sans souci !

Pour l'instant j'utilise uniquement les jeux de sélection car en mettant highlight à True cela permet rapidement et facilement de contrôler à l'écran si le code a bien fonctionné.

À terme j'aurai besoin de copier des sélections vers d'autres étages, ainsi que de réaliser des calculs via les données stockées dans les attributs ou les paramètres dynamiques du bloc.

Je suppose qu'il faut avoir un jeu de sélection pour faire des copies de bloc, ou bien il suffit de stocker dans un tableau, et via le tableau on peut recopier les blocs à l'écran?

 

[didier]

Bonjour @rrobert

Content que ça corresponde à la demande.
Toutefois, ce jeu de sélection en tant que tel n'est pas forcément utile.
Il est possible de lancer une action sur les bons blocs depuis le premier jeu de sélection en lançant l'action pendant le premier filtrage, ça évite une boucle plus ou moins longue suivant le nombre de blocs.
Que ce soit une copie ou une intervention sur les attributs.

Amicalement

[Curlygoth]

Citation

Je suppose qu'il faut avoir un jeu de sélection pour faire des copies de bloc, ou bien il suffit de stocker dans un tableau, et via le tableau on peut recopier les blocs à l'écran?

Méthode : obj.copy pt1,pt2

pt1 point de base (peut être 0,0,0)

PT2 point de destination

Pour toi :
 

PT2(0) = PT1(0)

PT2(1) = PT1(0)+50

PT2(2) = PT1(2)

EDIT : Jamais essayé sur une sélection désolé ^^ (mais tu peux toujours parcourir ta sélection)

[(gile)]

Il y a 4 heures, rrobert a dit :

Je suppose qu'il faut avoir un jeu de sélection pour faire des copies de bloc, ou bien il suffit de stocker dans un tableau, et via le tableau on peut recopier les blocs à l'écran?

En programmation, un jeu de sélection ne peut être traité tel quel qu'en appelant des commandes AutoCAD (et en VBA ce n'est pas si simple parce que SendCommand n'accepte qu'une chaîne de caractères).

Pour traiter un jeu de sélection (généralement obtenu pas une entée utilisateur) on le parcourt et on traite chacune des entités qu'il contient, par exemple, pour copier un jeu de sélection, on copie et délace chaque entité (avec Copy et Move en VBA).

C'est pour ça que très tôt dans ce fil certains t'on demandé si tu avais vraiment besoin d'un jeu de sélection et dans ton cas, comme il n'y a pas d'intervention de l'utilisateur pour sélectionner les objets, on aurait pu s'en passer depuis le début, en parcourant toutes les entités de l'espace objet et en traitant directement celles qui remplissaient les critères.

Bon, ça aura servi a approfondir l'usage des filtres de sélection...