删除很多同名块中的指定颜色和指定文字

yucc

mikewolf2k 发表于 2016-1-29 13:17
做个过滤器，遍历所有的块，然后在这个集合中的块元素去做上面那些事。不要用ThisDrawing.Blocks(Sube.Na ...

Dim ss As AcadSelectionSet
Dim i As AcadEntity
Set ss = ThisDrawing.ActiveSelectionSet
Dim ft(0) As Integer
Dim fd(0) As Variant
ft(0) = 62                 '组码
fd(0) = "5"                '颜色码
ss.Select acSelectionSetAll, , , ft, fd

    For Each i In ss
      If i.ObjectName = "AcDbline" Then
         i.Delete
      End If
    Next i

mikewolf2k

yucc 发表于 2016-1-29 13:52
Dim ss As AcadSelectionSet
Dim i As AcadEntity
Set ss = ThisDrawing.ActiveSelectionSet

这样不可以吧？这样获得的是直接的line，你是要块中的，就得遍历块，然后遍历块中的子元素，符合要求再处理。

yucc

mikewolf2k 发表于 2016-1-29 15:24
这样不可以吧？这样获得的是直接的line，你是要块中的，就得遍历块，然后遍历块中的子元素，符合要求再处 ...

实在搞不定了 太水

yucc

mikewolf2k 发表于 2016-1-29 13:17
做个过滤器，遍历所有的块，然后在这个集合中的块元素去做上面那些事。不要用ThisDrawing.Blocks(Sube.Na ...

还请能帮个忙，解决一下

yucc

mikewolf2k 发表于 2016-1-29 15:24
这样不可以吧？这样获得的是直接的line，你是要块中的，就得遍历块，然后遍历块中的子元素，符合要求再处 ...

Sub Ltoc(blk As AcadBlock)
Dim Sube As AcadEntity
For Each Sube In blk

    If Sube.ObjectName = "AcDbLine" Then
        Dim ss As AcadSelectionSet
            Set ss = ThisDrawing.ActiveSelectionSet
        Dim ft(0) As Integer
        Dim fd(0) As Variant
            ft(0) = 62                 '组码
            fd(0) = "5"                '颜色码
            ss.Select acSelectionSetAll, , , ft, fd
        For Each ss In Sube
                 ss.Delete
        Next

    End If
Next

End Sub

zzyong00

如果是删除指定内容的文字，用acadtext的TextString 属性，如果是颜色，哪用到TrueColor属性，这个属性是AcadAcCmColor 对象，略麻烦，看你要用什么 ColorMethod指定颜色了