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,
Solved! Go to Solution.
Solved by joh.richard. Go to Solution.
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?
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