[编程交流] 清除所有未引用的块

Dim Block As AcadBlockReference
For Each Paperino In ThisDrawing.SelectionSets
    If Paperino.name = "BOM" Then
       ThisDrawing.SelectionSets("BOM").Delete
    Exit For
    End If
 Next
Dim PT1(0 To 2) As Double
Dim PT2(0 To 2) As Double
 PT1(0) = 0#   'X
 PT1(1) = 0#   'Y
 PT1(2) = 0#   'Z
 
 PT2(0) = 170# 'X1
 PT2(1) = 260# 'Y1
 PT2(2) = 0# '  Z1
 
 GC(0) = 0
 GC(1) = 2
 GV(0) = "INSERT"
 '---------------------------------------------------
 'Revise the block name "tendnum1" for your application
   GV(1) = "$Conf*"
 intCode(0) = 0: 
 intCode(1) = 2: 
 '---------------------------------------------------
 ThisDrawing.SelectionSets.Add ("BOM")
 Set Ssnew = ThisDrawing.SelectionSets("BOM")
 Ssnew.Select acSelectionSetCrossing, PT2, PT1, intCode, GV
 
 For Each Entity In Ssnew
       Set Block = Entity
       BlockName = Block.name
       If Left$(BlockName, 5) = "$Conf" Then
       Block.Delete
next