PickfirstSelectionSet

[joh.richard]

Bonjour

j'ai de la difficulté avec la sub suivante...

Sub Example_PickfirstSelectionSet()
' This example lists all the objects in the pickfirst selection set.
' Before running this example, create some objects in the active
' drawing and select those objects. The objects currently selected
' in the active drawing will be returned in the pickfirst selection set.

Dim pfSS As AcadSelectionSet
Dim ssobject As AcadEntity
Dim msg As String
msg = vbCrLf

Set pfSS = ThisDrawing.PickfirstSelectionSet
For Each ssobject In pfSS
msg = msg & vbCrLf & ssobject.ObjectName
Next ssobject
MsgBox "The Pickfirst selection set contains: " & msg

End Sub 

 Si j'éxécute cette routine avec alt+F8, je n'ai aucun problème elle fonctionne bien.

Si je crée un bouton dans ma toolpallette avec la commande suivante : ^C^C-vbarun Example_PickfirstSelectionSet

Ça ne fonctionne pas "Selection set was deleted"

Est-ce que quelqu'un aurait une idée de la problématique?

Merci!

[olivier.eckmann]

Bonjour,

Dans le bouton, il faut enlever ^C^C car cette séquence simule un Echap pour déselctionner les ojets sélectionnés.

Olivier

[joh.richard]

Merci olivier.eckmann pour l'information, mais étrangement ça ne fonctionne pas chez nous.

Voici ce qui a fonctionné pour moi..^C^C(vl-load-com)(vla-runmacro (vlax-get-acad-object) "Example_PickfirstSelectionSet")

Mais je me retrouve avec un autre probleme...

Dim PfSS As AcadSelectionSet
    Dim ssetObj As AcadSelectionSet
    
    Set PfSS = ThisDrawing.PickfirstSelectionSet
    
    On Error Resume Next
    ssetObj.Delete

    On Error GoTo 0
    If PfSS.Count > 0 Then
        Set ssetObj = PfSS
        Call ChangeLayer(ssetObj)
        ssetObj.Delete
    End If

    On Error Resume Next
    ThisDrawing.SelectionSets.item("ss2").Delete
    ssetObj2.Erase
    On Error GoTo 0
    
    Set ssetObj2 = ThisDrawing.SelectionSets.Add("ss2")
    ssetObj2.SelectOnScreen
        Call ChangeLayer(ssetObj2)
    ssetObj2.Clear

End Sub

Si je selectionne des objets puis démarre la sub, le PickFirstSelectionSet fonctionne mais le SelectOnScreen non

Par contre si je n'ai rien de selctionné le SelectOnScreen fonctionne à merveille.

Des idées?

Merci!

[joh.richard · Accepted solution]

 Dim PfSS As AcadSelectionSet
    Dim ssetObj As AcadSelectionSet
    Dim ssetObj2 As AcadSelectionSet
    
    'PickfirstSelectionSet = Des objets qui sont déjà sélectionnés à l'écran
    Set PfSS = ThisDrawing.PickfirstSelectionSet

    On Error Resume Next
    
    ssetObj.Delete
    ssetObj2.Delete
    ThisDrawing.SelectionSets.item("ss1").Delete
    ThisDrawing.SelectionSets.item("ss2").Delete

    On Error GoTo 0

    'Validation si des objets ont été sélectionnés
    If PfSS.Count > 0 Then
        Set ssetObj = PfSS
        Call Lay_PropExstDemo2(ssetObj, sObjLayerExtens)
        ssetObj.Delete
        'clear pickfirst selection ; Je n'ai pas trouvé d'autre moyen pour enlever la selection existante à l'écran que de refaire une selection d'objet
        Set ssetObj = ThisDrawing.SelectionSets.Add("ss1")
        ssetObj.SelectOnScreen
        ssetObj.Clear
        ThisDrawing.Regen acActiveViewport
    End If

    'Demander à l'utilisateur de sélectionner des objets
    Set ssetObj2 = ThisDrawing.SelectionSets.Add("ss2")
    ssetObj2.SelectOnScreen
  
    Call Lay_PropExstDemo2(ssetObj2, sObjLayerExtens)
    ssetObj2.Clear