选择VBA之前和af

Grenco · 发表于 2022-7-6 14:20:10

我一直忙于一项日常工作，现在我就是这样做的；

我在按钮中使用以下命令启动例程：
-vbarun；GEA\u ATT\u CH.dvb！此图纸。删除met_过滤器；

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

我想将erase命令重新定义为vba例程。我想这不是问题。但还有一个问题。

如果您首先选择某个项目，然后启动该例程，则该例程将起作用。但我也希望它在例行程序开始之前没有进行选择的情况下工作。就像删除命令一样，你选择你的对象，然后启动命令，或者启动命令，然后选择你的对象。它以两种方式工作。

如果我在没有选择任何对象的情况下启动例程。例程使用以前选择的项目。此图纸。除非从图形中删除这些项目，否则ActiveSelectionSet总是满的。我需要另一种选择对象的方法。你有什么想法吗？？

我试过在宏前面使用“select”命令。但我没能让它工作。（^C^Cselect；\-vbarun；GEA\u ATT\u CH.dvb！Thisdrawing.Delete\u met\u Filter；。然后我在例程中使用：“set2.Select acSelectionSetPrevious”）可能我用错了？或者有没有其他方法可以将某些内容放在宏前面？你能让它工作吗？

总之，问题是：
如何在例程中读取在例程开始之前选择的选项（在set2中设置）。（一个想法？也无法实现）。如果没有进行选择，并且用户需要在例程启动后选择项目，则该选项也可以使用。（如果..那么…在屏幕上选择？？）

谢谢你的帮助！

Grenco · 发表于 2022-7-6 15:56:08

我修好了！

copy

 
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

[编程交流] 选择VBA之前和af

发表回复

精选推荐