Grenco Posted June 30, 2009 Posted June 30, 2009 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! Quote
Grenco Posted July 1, 2009 Author Posted July 1, 2009 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 Quote
Recommended Posts
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.