Тема: Как вставить координаты блока в его атрибуты?

Помогите реализовать программный код, посредством которого в атрибуты блока вписываются значения его координат. Заранее благодарен!

Re: Как вставить координаты блока в его атрибуты?

> KyCOK
Возьми за основу
Устанавливает значение атрибутов для всех блоков
рисунка с указанным именем

Option Explicit
' Выставить в опциях:
' Tools->Options->General->Break on Unhandled Errors
Sub ChAttByInsPoint()
    Dim oSset As AcadSelectionSet
    Dim oBlkRef As AcadBlockReference
    Dim oAttRef() As AcadAttributeReference
    Dim ftype(2) As Integer
    Dim fdata(2) As Variant
    Dim dxfCode, dxfValue
    Dim bname As String
    Dim i As Long
    On Error GoTo Error_Control
    With ThisDrawing.SelectionSets
        While .Count > 0
            .Item(0).Delete
        Wend
        Set oSset = .Add("XYZ_Blocks") ' приемлемо любое имя для набора
    End With
    bname = InputBox("Введите имя блока:", "Редактирование атрибутов")
    If StrComp(bname, "") = 0 Then Exit Sub
    If Not BlockExists(ThisDrawing, bname) Then
        MsgBox "Блок с именем " & Chr(34) & bname & Chr(34) & "не существует"
        Exit Sub
    End If
    ftype(0) = 0: ftype(1) = 2: ftype(2) = 66
    fdata(0) = "INSERT": fdata(1) = bname: fdata(2) = 1
    dxfCode = ftype: dxfValue = fdata
    oSset.Select acSelectionSetAll, , , dxfCode, dxfValue
    If oSset.Count = 0 Then Exit Sub
    For Each oBlkRef In oSset
        If oBlkRef.HasAttributes = True Then
            oAttRef = oBlkRef.GetAttributes
            Dim InsPt As Variant
            InsPt = oBlkRef.InsertionPoint
            For i = LBound(oAttRef) To UBound(oAttRef)
                Dim objAtt As AcadAttributeReference
                Set objAtt = oAttRef(i)
                Select Case UCase(oAttRef(i).TagString)
                Case "X"    ' атрибут для Х координаты
                    objAtt.TextString = CStr(Round(CDbl(InsPt(0)), 3))
                Case "Y"    ' атрибут для Y координаты
                    objAtt.TextString = CStr(Round(CDbl(InsPt(1)), 3))
                Case "Z"    ' атрибут для Z координаты
                    objAtt.TextString = CStr(Round(CDbl(InsPt(2)), 3))
                End Select
                objAtt.Update
            Next
            Erase oAttRef
        End If
    Next
Exit_Here:
    oSset.Delete
    If Not oBlkRef Is Nothing Then Set oBlkRef = Nothing
    Exit Sub
Error_Control:
    Select Case Err.Number
    Case -2147024809
        Resume Exit_Here
    Case Else
        MsgBox Err.Description, vbCritical
        Err.Clear
        Resume Exit_Here
    End Select
End Sub
Public Function BlockExists(aDoc As AcadDocument, blkName As String) As Boolean
    Dim oBlock As AcadBlock
    On Error Resume Next
    Set oBlock = aDoc.Blocks(blkName)
    BlockExists = (Err.Number = 0)
End Function

~'J'~