清除所有未引用的块
是否有VBA例程可以清除VBA中所有未使用或未删除的块?我注意到如果我用这幅画。PurgeAll我的绘图中还有一些剩余的参考块。
如果手动清除它们,这些非反射块就会消失。
那么,有没有VBA例程可以用VBA清除所有未使用或未消除的块?
非常感谢。 一个选项(许多选项中)。。。将逐步选择图形中的所有块,将其有效名称存储到LayerNameList变量中。然后,对于块集合中的每个块,如果EffectiveName不是LayerNameList的成员,则删除(从块集合中):眨眼:
希望这有帮助! 我使用选择集
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]