Grenco 发表于 2022-7-6 14:20:53

在ActiveSel中过滤对象

大家好!
 
我有个新问题要问你。。。
 
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
 
有点乱。但无论如何。这就是我想要的工作方式。
1.用户在屏幕上选择与普通autocad类似的项目(没有激活的命令)
2、用户按下删除(按钮)或擦除命令。
3.在VBA中过滤活动选定对象。首先是acadblock,然后是属性,然后是blockname。
4.查看属性his tagstring是否为“NOTE_2”,textstring是否为“Checked”
5、“选中”属性后,用户可以选择删除或保留该对象。当他单击KEEP object时,我想从activeselection集中删除当前选中的块。但是activeselectionset是只读的。所以我不能从那里删除它。我将activeselection放在另一个名称(SSET2)中,在这个名称中我可以更改、删除、添加等,并最终从图形中删除过滤后的对象。
6、常规结束时。删除/擦除命令仍在删除activeselection集。我怎么能绕过这个?删除activeselectionset不是一个选项,因为它是只读的?!我怎么能中止这个命令呢??
 
谢谢你的想法

Grenco 发表于 2022-7-6 16:18:25

---新建主题---
http://www.cadtutor.net/forum/showthread.php?t=37771
页: [1]
查看完整版本: 在ActiveSel中过滤对象