перенос данных из excel в autocad

[Kefirrr]

Доброе всем время суток, уважаемые форумчане!
Надеюсь на вашу помощь, или может быть направите меня в правильное русло.
У меня есть автокадовский файл, в нем несколько блоков с атрибутами. есть excel-файл , где с помощью макроса я переношу все значения атрибутов из автокада к себе в табличку. (должны быть открыты оба документа)
Вопрос в следующем: я хочу поменять в xls-табличке значения некоторых параметров, и чтобы они перенеслись в автокадовский документ. Как можно видоизменить макрос, чтобы решить эту проблему.

(прикладываю архив с xls- и dwg-файлами)

Заранее спасибо

[doober]

Выложите файл dwg в версии для 2007-2008 или 2012

[Kefirrr]

прикрепляю файл в версии 2004 autocad

[doober]

Пример для одного блока.Поиск производится по точке вставки рамкой +-2 единицы от точки вставки.

Const acSelectionSetCrossing As Integer = 1
Sub zamena()
    Set ACADApp = GetObject(, "AutoCAD.Application")
    Set ADOC = ACADApp.ActiveDocument
    Dim pt1(0 To 2) As Double, X As Double, Y As Double
    Dim pt2(0 To 2) As Double
    X = 8952.35416254935
    Y = 9175.84467999433
    pt1(0) = X - 2
    pt2(0) = X + 2
    pt1(1) = Y - 2
    pt2(1) = Y + 2
    Set objSelCol = ADOC.SelectionSets
    For Each objSelSet In objSelCol
        If objSelSet.Name = "a_doober" Then
            objSelSet.Delete
            Exit For
        End If
    Next
    Set objSelSet = objSelCol.Add("a_doober")

    objSelSet.Select acSelectionSetCrossing, pt1, pt2

    For Each entry In objSelSet

        ObjectName = entry.ObjectName
        If ObjectName = "AcDbBlockReference" Then

            For Each attribs In entry.GetAttributes
          
                Select Case attribs.TagString

                Case "НАИМЕНОВАНИЕ"
                    attribs.TextString = "Что то новое"
                Case "ПОЗИЦИЯ"
                    attribs.TextString = "Что то новое"
                Case "СИСТЕМА"
                    attribs.TextString = "Что то новое"
                Case "ОБОЗНАЧЕНИЕ"
                    attribs.TextString = "Что то новое"
                Case "ПРИМЕЧАНИЕ"
                    attribs.TextString = "Что то новое"
                End Select
            Next
            
            entry.Update
                End If
        Next entry

    objSelSet.Delete
    ADOC.Close (True)
  Set ADOC = Nothing
  ACADApp.Quit
 Set ACADApp = Nothing
End Sub

[Kefirrr]

doober, спасибо за быстрый ответ. Но у меня все время ссылается на то, что не может найти объект ACADApp и т.д. может подскажете почему такое?

[doober]

У вас есть ссылки на автокад 2013.где вы их подцепили,не знаю.
Зайдите в tools-references,удалите missing на недостающие библы.
Или создайте новую книгу,модуль,в него код,скопируйте данные с листа на лист

[Kefirrr]

Все заработало. Огромное спасибо. Пойду разбираться детально с кодом