Filtering objects in ActiveSelection

[Grenco]

Hi all!

 

I got a new question for you...

 

Private Sub ACADApp_BeginCommand(ByVal CommandName As String)
   Dim Ssett2 As AcadSelectionSet
   Dim Blocks As AcadBlockReference
   Dim II As Integer
   Dim AttarrayY As Variant
   Dim Varatts As AcadAttributeReference
   Dim Viewobj_center(0 To 2) As Double
   Dim SelBlock(0) As AcadEntity

On Error GoTo ErrorHandler
       Set Ssett2 = thisdrawing.ActiveSelectionSet
       thisdrawing.ActiveSelectionSet.Clear

   If CommandName = "ERASE" Or CommandName = "SELECT" Then
       'If Ssett2.count < 2 Then
         '  Set Ssett2 = thisdrawing.SelectionSets.Add("XXX")
    '           Ssett2.SelectOnScreen
      ' End If
           For Each Blocks In Ssett2
               If Blocks.ObjectName = "AcDbBlockReference" Then
                   If ((Blocks.HasAttributes) And (Left(Blocks.Name, 3) = "G_B") Or (Left(Blocks.Name, 3) = "G_E") Or (Left(Blocks.Name, 3) = "G_I") Or (Left(Blocks.Name, 3) = "G_L")) Then
               thisdrawing.StartUndoMark

                           AttarrayY = Blocks.GetAttributes
                           For II = 0 To UBound(AttarrayY)
                           Set Varatts = AttarrayY(II)
                               If Varatts.TagString = "NOTE_2" And Varatts.TextString = "Checked" Then

                           Viewobj_center(0) = Blocks.InsertionPoint(0) - 30: Viewobj_center(1) = Blocks.InsertionPoint(1): Viewobj_center(2) = 0
                               'Dim viewX As Double

                               'viewX = Viewobj_center(0) - 30
                               AutoCAD.ZoomCenter Viewobj_center, 80

                               G_ans_erase = MsgBox("Wilt u dit block hiernaast verwijderen?", vbYesNo + vbDefaultButton2, "Controle block-verwijdering")

                                   Set SelBlock(0) = Blocks
                               If G_ans_erase = vbNo Then
                                   Ssett2.RemoveItems SelBlock
                                   'thisdrawing.SendCommand ("undo" & vbCr & "1" & vbCr)
                               End If

                              AutoCAD.Update
                              DoEvents
                              'MsgBox "Checked Item"


                           II = II + 1
                           End If

                Next


                   Else

                       MsgBox "Geen Attributes aanwezig"
                   End If
               Else
                   MsgBox Blocks.ObjectName 'If Blocks.ObjectID = Then
               End If
           Next Blocks

           'MsgBox CommandName

   End If

Exit Sub
ErrorHandler:
If Err.Number = 13 Then
Err.Clear
Resume Next
Else
MsgBox Err.Number & Err.Description
End If

Ssett2.Clear
End Sub

 

It's a bit messy. But anyway. This is how i want it to work.

1. User selects items on screen like normal autocad (no command active)

2. User pressed DELETE(button) or Erase command.

3. Filter activeselected objects in VBA. First if acadblock, then has attributes, then blockname.

4. See if an attribute his tagstring is "NOTE_2" and textstring "Checked"

5. When a attribute is "Checked" there is a choice for the user to delete or keep the object. When he clicks KEEP object, I want to delete the current checked block from the activeselection set. But the activeselectionset is READ ONLY. So I cant delete it from there. I've put the activeselection in an other name (ssett2) wich I can change, delete, add, etc. And finaly delete my filtered object from my drawing.

6. When the routine is ended. The DELETE/ERASE command is still deleting the activeselection set. How can i bypass this? Deleting the activeselectionset isnt an option because it is read only?! How can I abort this command to happen??

 

Thanks for your ideas

[Grenco]

--- New topic ---

http://www.cadtutor.net/forum/showthread.php?t=37771