New Select object , keep object already selected

[joh_richard]

HI

I Have code that change object layer

My problem is ... I want keep the last object selected (text, line, block...) and be able to add new object (select on screen)

My initial code was

Dim sset        As AcadSelectionSet
Dim acEnt       As AcadEntity     
Dim objlayer    As AcadLayer        

On Error Resume Next     

ThisDrawing.SelectionSets.Item("SS1").Delete  

Set sset = ThisDrawing.SelectionSets.Add("SS1")
sset.SelectOnScreen
....

 I'm going to remove the . Delete

I try with sset.Select acSelectionSetLast, but it's not working.

Is anyone know the solution?

Thanks

[Hallex]

Try similar code, not finished to your needs, just a quick demo

Change entity names In the filter

Option Explicit
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
' NOTE:
' Go to Tools--> Options --> General tab --> Error Traping --> check "Break on Unhandled Errors"
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

Public Sub TextSelection()
Dim ent As AcadEntity

Dim objSSet As AcadSelectionSet
Dim setObj As AcadSelectionSet
Dim oText As AcadText
Dim oMText As AcadMText
Dim intFilterType(0 To 0) As Integer
Dim varFilterData(0 To 0) As Variant
Dim dxfCode, dxfValue
intFilterType(0) = 0: varFilterData(0) = "TEXT,MTEXT,INSERT,LINE,CIRCLE,LWPOLYLINE"


   ' Creates an empty selection set.
       Dim setColl As AcadSelectionSets
     With ThisDrawing
          Set setColl = .SelectionSets
          For Each setObj In setColl
               If setObj.Name = "mySelSet" Then
                    .SelectionSets.item("mySelSet").Delete
                    Exit For
               End If
          Next
          Set objSSet = .SelectionSets.Add("mySelSet")
     End With

objSSet.SelectOnScreen intFilterType, varFilterData
If objSSet.Count = 0 Then
Exit Sub
End If
Dim before As Integer
before = objSSet.Count
MsgBox "Selected objects: " & before & vbCr & _
 "Select single objects, hit Enter to stop "
Dim Util As AcadUtility
Set Util = ThisDrawing.Utility
 Dim pickPt As Variant
 Dim oEnt As AcadEntity

    On Error Resume Next
    Do
      
        Util.GetEntity oEnt, pickPt, vbCr & "Select object: "
        If Err.Number <> 0 Then
        Debug.Print Err.Description
            Exit Do
        Else
        ReDim addObjs(0 To 0) As AcadEntity
       Set addObjs(0) = oEnt
       ' Add the array of object to the selection set
        objSSet.AddItems addObjs

        End If
    Loop
  
objSSet.Update

MsgBox "Added objects: " & CStr(objSSet.Count - before) & vbCr & _
 "All selected: " & CStr(objSSet.Count)
End Sub

[joh.richard]

Thanks Hallex for your help.

It does not match exactly to my needs.
If at the start of vba there are objects that are selected I want to keep then in my selection and I want to be able to add new objects selected by the user.