Jump to content

Filtering objects in ActiveSelection


Grenco

Recommended Posts

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 :D

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...