批量删除CAD中块（block）（vba实现，上百个CAD文件一键完成）

         当我们需要删除大量cad文件中的块时，一个一个打开删除关闭，费时又费力。此代码实现了一键删除功能，只需把所有dwg文件放入同一个文件夹，打开cad，alt+F11打开vba开发环境，复制代码，F5运行。（或加载此插件命令栏输入： appload  ,然后加载此dvb文件，输入 vbarun 运行宏即可）。

部分代码如下：

Sub 批量删除块block()
'yngqq443440204
Dim folderPath As String
Dim path As String
Dim counter As Integer
counter = 0 '计数器，记录替换的文字数量
Dim fileName As String
Dim acadDoc As AcadDocument
folderPath = "C:\Users\Administrator\Desktop\新建文件夹" '替换成你的文件夹路径
fileName = Dir(folderPath & "\*.dwg")  '获取文件夹中的DWG文件
Dim ent As AcadEntity
Do While fileName <> ""
  *****省略部分代码
Loop
MsgBox "共删除了 " & counter & " 个块 " & Space(20) & vbCr & "qq", , "版权所有qq:"
End Sub

由下图可知，共删除了文件夹内cad文件3个块。

删除dxf中的块

Sub 批量删除块block()
On Error Resume Next
Dim folderPath As String
Dim path As String
Dim counter As Integer
counter = 0 '计数器，记录替换的文字数量
Dim fileName As String
Dim acadDoc As AcadDocument
folderPath = "C:\Users\Administrator\Desktop\718\难\dxf"
fileName = Dir(folderPath & "\*.dxf")  '获取文件夹中的DWG文件
Dim ent As AcadEntity
Do While fileName <> ""
   ****省略部分代码
Loop
MsgBox "共删除了 " & counter & " 个块 " & Space(20) & vbCr & "", , "版权所有qq:"
End Sub

  Set acadDoc = Documents.Open(folderPath & "\" & fileName)
    For Each ent In ThisDrawing.ModelSpace
    If ent.ObjectName = "AcDbBlockReference" Then
        ent.Delete
        counter = counter + 1
    End If
    Next ent
    ThisDrawing.Close
    fileName = Dir()