bluemoon 发表于 2003-7-12 19:01:00

斑竹啊 救救我吧！！！！！！！！！

能不能 把CAD中块的名称删除啊   ？？？怎么用程序实现呢？

mccad 发表于 2003-7-12 20:01:00

没明白，块的名称删除，那块呢，是否保留？

bluemoon 发表于 2003-7-12 22:16:00

哦 应该是把知道名称的块删除
但是我不是用INSERT 插入的
是CAD 中可以查到的
但我用CAD查询查出是ACDBBLOCKREFENCE
对不起 我的问题是太菜了

mccad 发表于 2003-7-13 07:10:00

你是想将图面上某个名称的图块全部删除，是吗？

bluemoon 发表于 2003-7-13 15:40:00

是的 斑竹
有什么办法吗？

mccad 发表于 2003-7-13 19:08:00

Sub DelBlkByName()
    Dim BlockName As String
    BlockName = "11"'这里保存着要删除的图块名称
    Dim ss As AcadSelectionSet
    Set ss = CreateSelectionSet()
    Dim fType As Variant
    Dim fDate As Variant
    BuildFilter fType, fData, 0, "INSERT", 2, BlockName
    ss.Select acSelectionSetAll, , , fType, fData
    Dim Ent As AcadEntity
    Dim i As Integer
    i = ss.Count
    If i > 0 Then
      For Each Ent In ss
            Ent.Delete
      Next
      Update
      MsgBox "图形中共有" & i & "个名称为“" & BlockName & "”的图块，都已经被删除了。", , _
                "明经通道VBA示例"
    Else
      MsgBox "图形中没有名称为“" & BlockName & "”的图块存在。", , _
                "明经通道VBA示例"
    End If
End Sub

Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet

    Dim ss As AcadSelectionSet
   
    On Error Resume Next
    Set ss = ThisDrawing.SelectionSets(ssName)
    If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
    ss.Clear
    Set CreateSelectionSet = ss

End Function

Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
    Dim fType() As Integer, fData()
    Dim index As Long, i As Long
   
    index = LBound(gCodes) - 1
      
    For i = LBound(gCodes) To UBound(gCodes) Step 2
      index = index + 1
      ReDim Preserve fType(0 To index)
      ReDim Preserve fData(0 To index)
      fType(index) = CInt(gCodes(i))
      fData(index) = gCodes(i + 1)
    Next
    typeArray = fType: dataArray = fData
End Sub

bluemoon 发表于 2003-7-14 11:07:00

谢谢斑竹！！！
页: [1]
查看完整版本: 斑竹啊 救救我吧！！！！！！！！！