Динамические блоки

Option Explicit
Sub SelectDynBlocksInModel()
' tested on A2008 only
     Dim ss As AcadSelectionSet
     Dim ent As AcadEntity
     Dim bname As String
     bname = "2__DR__1__ DF_ SINK_ FRONT" '<--change block name here
     Dim pvalue As Variant
     Dim blkRef As AcadBlockReference
     With ThisDrawing.SelectionSets
          While .Count > 0
               .Item(0).Delete
          Wend
          Set ss = .Add("$DynBlocks$")
     End With
     Dim ftype(2) As Integer
     Dim fdata(2) As Variant
     pvalue = 25.4 ''<--change distance value here
     ftype(0) = 0: ftype(1) = 2: ftype(2) = 67
     fdata(0) = "INSERT": fdata(1) = "`*U#*" & "," & bname: fdata(2) = 0 '<--"2__DR__1__ DF_ SINK_ FRONT" <--change block name
     ss.Select acSelectionSetAll, , , ftype, fdata
  If ss.Count > 0 Then
  MsgBox ss.Count
  For Each ent In ss
  Set blkRef = ent
  If blkRef.IsDynamicBlock Then
  If blkRef.EffectiveName = bname Then
  Dim props() As AcadDynamicBlockReferenceProperty
  Dim i As Integer
  props = blkRef.GetDynamicBlockProperties
  Dim prop As AcadDynamicBlockReferenceProperty
For i = LBound(props) To UBound(props)
Set prop = props(i)
If prop.PropertyName = "Distance" Or prop.PropertyName = "Distance1" Then
prop.Value = pvalue
End If
Next i
End If
End If
Next ent
End If
ss.Delete
End Sub