<Autodesk.AutoCAD.Runtime.CommandMethod("BXYZDIFFS")> _
Public Sub BXYZDIFFS()
Const anchorBlockName As String = "Анкер (Стандарт)"
Const anchorBlockLayer As String = "0_АНКЕРА"
doc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
ed = doc.Editor
db = doc.Database
Dim blockIDs As ObjectIdCollection = New ObjectIdCollection
Try
Using lockDoc As DocumentLock = doc.LockDocument()
Using tr As Transaction = db.TransactionManager.StartTransaction
Using layerTab As LayerTable = tr.GetObject(db.LayerTableId, OpenMode.ForRead)
If layerTab.Has(anchorBlockLayer) = False Then
ed.WriteMessage(vbCrLf & "В чертеже не найден слой {0}. ", anchorBlockLayer)
Exit Sub
Else
Using layerTabRec As LayerTableRecord = tr.GetObject(layerTab(anchorBlockLayer), OpenMode.ForRead)
If (layerTabRec.IsOff Or layerTabRec.IsFrozen) Then
ed.WriteMessage(vbCrLf & "Слой {0} выключен и/или заморожен. ", anchorBlockLayer)
Exit Sub
End If
End Using
End If
End Using
Dim blockTab As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
If blockTab.Has(anchorBlockName) Then
Dim blockTabRec As BlockTableRecord = tr.GetObject(blockTab(anchorBlockName), OpenMode.ForRead)
'Анонимные блоки - различные состояния динамического блока,
'поэтому ищем все анонимные блоки
Dim anonBtrIDs As ObjectIdCollection = blockTabRec.GetAnonymousBlockIds
Dim layerTab As LayerTable = tr.GetObject(db.LayerTableId, OpenMode.ForRead)
For Each anonBtrID In anonBtrIDs
Dim anonBlockTabRec As BlockTableRecord = tr.GetObject(anonBtrID, OpenMode.ForRead)
'Получаем вхождения анонимых блоков
Dim brIDs As ObjectIdCollection = anonBlockTabRec.GetBlockReferenceIds(True, True)
For Each id In brIDs
Dim block As BlockReference = tr.GetObject(id, OpenMode.ForRead)
Dim layerTabRec As LayerTableRecord = tr.GetObject(layerTab(block.Layer), OpenMode.ForRead)
If Not (layerTabRec.IsOff Or layerTabRec.IsFrozen) Then
Dim parentBlockTabRec As BlockTableRecord = tr.GetObject(block.BlockId, OpenMode.ForRead)
If parentBlockTabRec.IsLayout Then
blockIDs.Add(id)
End If
End If
Next
Next
'Ищем блоки в неизменном состояния
Dim btrIDs As ObjectIdCollection = blockTabRec.GetBlockReferenceIds(True, True)
For Each btrID In btrIDs
Dim block As BlockReference = tr.GetObject(btrID, OpenMode.ForRead)
Dim layerTabRec As LayerTableRecord = tr.GetObject(layerTab(block.Layer), OpenMode.ForRead)
If Not (layerTabRec.IsOff Or layerTabRec.IsFrozen) Then
Dim parentBlockTabRec As BlockTableRecord = tr.GetObject(block.BlockId, OpenMode.ForRead)
If parentBlockTabRec.IsLayout Then
blockIDs.Add(btrID)
End If
End If
Next
Else
ed.WriteMessage(vbCrLf & "Не найден блок {0}. ", anchorBlockName)
Exit Sub
End If
ed.WriteMessage(vbCrLf & blockIDs.Count.ToString & " ")
tr.Commit()
End Using
End Using
Catch ex As Exception
ed.WriteMessage(vbCrLf & "Во время выполнения произошла ошибка. " & ex.Message)
End Try
End Sub
