选择VBA之前和af
我一直忙于一项日常工作，现在我就是这样做的；我在按钮中使用以下命令启动例程：
-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中设置）。（一个想法？也无法实现）。如果没有进行选择，并且用户需要在例程启动后选择项目，则该选项也可以使用。（如果..那么…在屏幕上选择？？）
谢谢你的帮助！ 我修好了！
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
页:
[1]