jeu de sélection dupliqué

[sechanbask]

Bonjour,

 

j'ai un problème sur un jeu de selection, je n'arrive pas à le supprimer donc la commande ne peut pas être réutilisée :

 

-2145320851 Le jeu de sélection nommé existe

 

Sub wbloquer()

On Error GoTo gestionWbloquer

ThisDrawing.ActiveLayer = ThisDrawing.layers("0")


ThisDrawing.SelectionSets.Add("S1").Clear
ThisDrawing.SelectionSets.Add("S1").Delete
ThisDrawing.SelectionSets.Add("S1").Update
  Dim ssetObj As AcadSelectionSet
  
  
  Set ssetObj = ThisDrawing.SelectionSets.Add("S1")

ssetObj.Select acSelectionSetAll

'ThisDrawing.Wblock("C:\AutoCAD\WBlock_example.dwg",)
Debug.Print ssetObj.Count
ssetObj.Clear
ssetObj.Delete
ssetObj.Erase
ssetObj.Update

'ThisDrawing.Utility.Prompt " Finalisée. Modifications enregistré dans le fichier." & " "

Exit Sub

gestionWbloquer:
Select Case Err.Number

Case Else
Debug.Print Err.Number; Err.Description

ThisDrawing.Utility.Prompt " Une erreur inconnue est survenue, veuillez contacter le développeur."


End Select
End Sub

 

 

comment réutiliser le jeu de sélection sans changer de nom. Merci d'avance

 

 

 

 

 

Réponse trouvée http://forums.augi.com/showthread.php?t=47894

 

[Edité le 20/1/2009 par sechanbask]

[Patrick_35]

Salut

 

Avec la fonction clear

 

Extrait de l'aide

Sub Example_Clear()
   ' This example creates a selection set and several objects.
   ' It then adds the objects to the selection set. It then
   ' clears the objects from 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
   GoSub LISTOBJS
   
   ' Clear the selection set
   ssetObj.Clear
   
   ThisDrawing.Regen acActiveViewport
   GoSub LISTOBJS
Exit Sub
LISTOBJS:
   
       ' List all the objects in the selection set
       If ssetObj.count = 0 Then
           MsgBox "The selection set is empty"
       Else
           For I = 0 To ssetObj.count - 1
               MsgBox "The selection set contains: " & ssetObj.Item(I).ObjectName
           Next
       End If
       Return
   
End Sub

 

@+

[sechanbask]

J'ai clear dans mon code alors je ne comprends pas ? et je n'arrive pas comprendre pourquoi, moi ça ne marche alors que celui là

 

Sub MySelectionSet()
Dim ss As AcadSelectionSet
On Error Resume Next
Set ss = ThisDrawing.SelectionSets.Add("Suman")
If Err.Number <> 0 Then
ThisDrawing.SelectionSets.Item("Suman").Delete
Set ss = ThisDrawing.SelectionSets.Add("Suman")
End If
ss.SelectOnScreen

MsgBox "Number of entities in the Selectionset is" & vbCrLf & ss.Count
End Sub

 

d'où vient mon erreur car j'utilise clear + delete aussi !!

 

[Edité le 21/1/2009 par sechanbask]

[rom1_am]

Bonjour,

Pourquoi est-ce que tu supprimes et recrées le jeu de sélection?

Si tu utilises seulement Clear pour vider ton jeu de sélection, puis que tu refais une sélection d'objet, cela ne fonctionne pas?

 

(Dsl, Je sais que ça répond pas vraiment à ton question, mais je vois pas ce qui cloche dans ton code...)

[sechanbask]

je fais un

 

ThisDrawing.SelectionSets.Add("S1").Clear

 

ThisDrawing.SelectionSets.Add("S1").Delete

 

ThisDrawing.SelectionSets.Add("S1").Update

 

Mais ça ne marche pas, je ne vois pas où est mon erreur mais avec le code que j'ai trouvé sur intenet et

posté le 20/1/2009 à 13:35, ça marche alors comme je n'ai ni le temps ni la patience de trouver d'où vient mon erreur...

[rom1_am]

Bonjour Sechanbask,

 

Dans ton code, j'utiliserais plutôt :

"ThisDrawing.SelectionSets.Item("S1").Clear"

à la place de : "ThisDrawing.SelectionSets.Add("S1").Clear"

 

En tout cas, Autocad génére une erreur si tu essaies d'ajouter un jeu de selection dont le nom existe déjà où alors si tu essaies d'en supprimer un qui n'existe pas.

Personnellement, j'utilise la fonction suivante pour créer/réinitialiser un jeu de sélection:

 

Function F_InitialiserJeuSelection(Nom As String) As AcadSelectionSet
'**********************************************************************
'Description: Efface et recrée un jeu de selection
'Parametres: nom du jeu de selection
'  Renvoie un jeu de selection
'**********************************************************************
   Dim i As Integer
   'Supprimer le jeu de sélection s'il existe
   For i = 0 To ThisDrawing.SelectionSets.Count - 1
     If ThisDrawing.SelectionSets.Item(i).Name = Nom Then
       ThisDrawing.SelectionSets.Item(i).Delete
       Exit For
     End If
   Next i
   'Créer un nouveau jeu de sélection vide
   Set F_InitialiserJeuSelection = ThisDrawing.SelectionSets.Add(Nom)
End Function 

 

Dans la procèdure où je veux utiliser mon jeu de sélection, j'appelle la fonction ainsi :

 

    Dim L_set_JeuSelection      As AcadSelectionSet
   'Créer un nouveau jeu de sélection vide 
   Set L_set_JeuSelection = F_InitialiserJeuSelection("selection_blocs") 
...

 

[sechanbask]

rom1_am > Avec un peu de retard je te remercie...

 

ça marche parfaitement dans le nouveau nettoyeur pour faire un wbloc !!

[lili2006]

Bonsoir à toutes et tous,

 

le nouveau nettoyeur

 

Aurais-je raté une étape ???? :mad: :o :cool: :exclam:

[sechanbask]

je suis dessus mais il est loin dêtre stable :

 

- nouvelles fonctions

- trop de fonctions donc modification de l'interface graphique

- toujours pas d'aplatisseur en route, j'arrive à rien de concret dans ce domaine...

[lili2006]

Re,

 

Ah ok !

 

Je continue de suivre ça de près alors,.... ;)