Jump to content

Selection to VBA before AND after command


Grenco

Recommended Posts

I've been busy with a routine and I worked it out like this for now;

 

I'm starting the routine with this command in my button:

-vbarun;GEA_ATT_CH.dvb!Thisdrawing.Delete_met_Filter;

 

Sub Delete_met_Filter()
   Dim set2 As AcadSelectionSet
   Dim II As Integer
   Dim AttarrayY As Variant
   Dim Varatts As AcadAttributeReference
   Dim ElEment As Object
   Dim Aantal As Double

thisdrawing.StartUndoMark
Aantal = 0

Set set2 = thisdrawing.ActiveSelectionSet <----- Needs to change to??

   For Each ElEment In set2
   With ElEment
       If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
           If ((ElEment.HasAttributes) And (Left(ElEment.Name, 3) = "G_B") Or (Left(ElEment.Name, 3) = "G_E") Or _
           (Left(ElEment.Name, 3) = "G_I") Or (Left(ElEment.Name, 3) = "G_L")) Then
               AttarrayY = ElEment.GetAttributes
               For II = 0 To UBound(AttarrayY)
                   Set Varatts = AttarrayY(II)
                   If Varatts.TagString = "NOTE_2" And Varatts.TextString = "Checked" Then
                       Aantal = Aantal + 1
               II = II + 1
                   End If
               Next
           Else
               set2.Erase
               GoTo Einde
           End If
       End If
   End With
   Next ElEment
   If Aantal >= 1 Then
       G_ans_erase = MsgBox("U heeft " & Aantal & " checked items in uw selectie, wilt u doorgaan?", vbYesNo + vbDefaultButton2, "Controle block-verwijdering")
       If G_ans_erase = vbYes Then
       set2.Erase
       GoTo Einde
       End If
       If G_ans_erase = vbNo Then
       GoTo Einde
       End If
   End If
   If Aantal = 0 Then
       set2.Erase
   End If

Einde:
set2.Clear
thisdrawing.EndUndoMark
End Sub

 

I want to redefine the erase command to the vba-routine. That's not a problem I guess. But there is another problem.

 

This routine works if you first select something and then start the routine. But I also want it to work when there isn't made a selection before the routine is started. Just like the delete commando, you select your objects, then you start the command OR you start the command, and then you select your objects. It works in both ways.

 

If I start the routine without any object selected. The routine uses the previous selected items. The thisdrawing.ActiveSelectionSet is always full unless those items are deleted from your drawing. I need an other way of selecting objects. Do you have an idea??

 

I've tried something with "select"-command in front of the macro. But I couldn't get it to work. (^C^Cselect;\-vbarun;GEA_ATT_CH.dvb!Thisdrawing.Delete_met_Filter; .. Then I used in the routine: "set2.Select acSelectionSetPrevious") Maybe I used it wrong? Or is there another way to put something in front of the macro? Can you het it to work?

 

Anyway, the question in short:

How to read a selection (set it in set2), wich is selected before the routine starts, in a routine. (pickfirstselection an idea? Couldn't get it to work either). AND ALSO works if there isn't a selection made and the user needs to select the items after the routine starts. (if .. then ...select on screen??)

 

thnx for your help!

Link to comment
Share on other sites

I got it fixed!

 

 
Dim DelSel As AcadSelectionSet
Dim Aantal As Double

Public Sub ACADApp_BeginCommand(ByVal CommandName As String)
  If CommandName = "SELECT" Then
       If thisdrawing.PickfirstSelectionSet.count >= 1 Then 'kijken of een actieve selectie is en wegzetten in DelSel
           Set DelSel = thisdrawing.PickfirstSelectionSet
       End If
       If thisdrawing.PickfirstSelectionSet.count = 0 Then 'als er geen actieve selectie is, select command uitvoeren
           On Error Resume Next
           Set DelSel = thisdrawing.SelectionSets.Add("NEW")
       End If
   End If
End Sub

Public Sub AcadDocument_EndCommand(ByVal CommandName As String)
   If CommandName = "SELECT" Then
   On Error Resume Next
       If DelSel.count < 1 Then             Set DelSel = thisdrawing.ActiveSelectionSet                                                                                    Call Delete_met_Filter
       Else
           Call Delete_met_Filter
       End If
   End If

   If CommandName = "ERASE" Then
       thisdrawing.SendCommand ("U" & vbCr)
       thisdrawing.SendCommand ("erase" & vbCr)
   End If
End Sub

Sub Delete_met_Filter()
   Dim II As Integer
   Dim AttarrayY As Variant
   Dim Varatts As AcadAttributeReference
   Dim ElEment As Object

Aantal = 0
On Error Resume Next
   For Each ElEment In DelSel
   With ElEment
       If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
           If ((ElEment.HasAttributes) And (Left(ElEment.Name, 3) = "G_B") Or (Left(ElEment.Name, 3) = "G_E") Or _
           (Left(ElEment.Name, 3) = "G_I") Or (Left(ElEment.Name, 3) = "G_L")) Then
               AttarrayY = ElEment.GetAttributes
               For II = 0 To UBound(AttarrayY)
                   Set Varatts = AttarrayY(II)
                   If Varatts.TagString = "NOTE_2" And Varatts.TextString = "Checked" Then
                       Aantal = Aantal + 1
               II = II + 1
                   End If
               Next
           End If
       End If

   End With
   Next ElEment

   If Aantal = 0 Then
   DelSel.Erase
   GoTo Einde
   End If

   If Aantal >= 1 Then
       G_ans_erase = MsgBox("U heeft " & Aantal & " checked items in uw selectie, wilt u doorgaan?", vbYesNo + vbDefaultButton2, "Controle block-verwijdering")
       If G_ans_erase = vbYes Then
           DelSel.Erase
           GoTo Einde
       End If
       If G_ans_erase = vbNo Then
           GoTo Einde
       End If
   End If

Einde:
DelSel.Delete
End Sub

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...