muck 发表于 2022-7-6 22:54:33

清除所有未引用的块

是否有VBA例程可以清除VBA中所有未使用或未删除的块?
我注意到如果我用这幅画。PurgeAll我的绘图中还有一些剩余的参考块。
如果手动清除它们,这些非反射块就会消失。
那么,有没有VBA例程可以用VBA清除所有未使用或未消除的块?
非常感谢。

BlackBox 发表于 2022-7-6 23:41:27

一个选项(许多选项中)。。。将逐步选择图形中的所有块,将其有效名称存储到LayerNameList变量中。然后,对于块集合中的每个块,如果EffectiveName不是LayerNameList的成员,则删除(从块集合中):眨眼:
 
希望这有帮助!

PeterPan9720 发表于 2022-7-7 00:07:56

我使用选择集
 

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
页: [1]
查看完整版本: 清除所有未引用的块