SelectionSet last / previous

[joh.richard]

Hi

I need your help with selection

I want to be able to select object and after start the vba, if nothings was selecting pass to the other command

I try this sset.Select acSelectionSetLast, but it only use the last object (1 entitie)

Dim sset	As AcadSelectionSet

'If objects are already selected process them
	Set sset = ThisDrawing.SelectionSets.Add(Now)
	set.Select acSelectionSetLast
        
	Call ChangeLayer (sset)		'Change the layer already selected entities

'The user selects the objects on the screen
	Set sset = ThisDrawing.SelectionSets.Add("SS1")
        sset.SelectOnScreen      	'user select object on screen
            
	Call Changelayer (sset)		'Change layer selected entities

And I try sset.Select acSelectionSetPrevious

But if the user didn't select object, the previous object select in this vba is process

Dim sset	As AcadSelectionSet

'If objects are already selected process them
	Set sset = ThisDrawing.SelectionSets.Add(Now)
	sset.Select acSelectionSetPrevious	
        
	Call ChangeLayer (sset)		'Change the layer already selected entities

'The user selects the objects on the screen
	Set sset = ThisDrawing.SelectionSets.Add("SS1")
        sset.SelectOnScreen      	'user select object on screen
            
	Call Changelayer (sset)		'Change layer selected entities

I try

Set sset = ThisDrawing.SelectionSets.Add(Now) .delete  or sset.Clear

I don't know how to "clear" the memories

So any suggestion will be welcome. Thanks,

[joh.richard]

ok, after workaround I got this

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

 But still have problem, If I select object and start the sub, the part of SelectOnScreen don't work!?!?!

Any idea?

[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