[seregas]

Коллеги, представим, что есть DWG , в котором есть пару сотен связей с Excel в виде одной ячейки (спец. вставка - связать - Объект AutoCAD). Даже не знаю, поле это или таблица из 1 ячейки. Каждая связь ссыается на path1/file1.xlsx. Как поменять макросом-VBA или LISP этот где-то скрытый в DWG текст на path2/file2.xlsx ?

Файлы file1.xlsx и file2.xlsx по структуре одинаковые, получены переименованием и заменой содержимого некоторых ячеек.

Вот для примера, похожий VBA-макрос для WORD, и он даже работает Берите, пригодится. Его надо только перевести для AutoCAD

Код:

[Выделить все]

Attribute VB_Name = "Замена_связей_Оригинальная"

Sub ChangeLinks()
  Dim oFld As Field 'Поле
  Dim OldFileName As String 'Старое имя файла
  Dim NewFileName As String 'Новое имя файла
  Dim FieldCode As String 'Код поля
  Dim ReplaceAllPath As Boolean 'Заменять весь путь к файлу или только имя
  Dim StartPath As Integer, EndPath As Integer 'Начало и конец пути к файлу в коде поля
  
  'Ввод старого имени файла
  OldFileName = InputBox("Укажите старое имя файла с расширением в ссылке, которое нужно изменить", "Изменение ссылок", OldFileName)
  If Len(OldFileName) = 0 Then Exit Sub
  
  'Выбор нового файла
  With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Выберите новый файл, с которым должен быть связан документ"
    .AllowMultiSelect = False
    .ButtonName = "Выбрать"
    .Filters.Clear
    .Filters.Add "Таблицы Excel", "*.xls; *.xlsx"
    If .Show Then NewFileName = .SelectedItems(1) Else Exit Sub
  End With
  
  'Если изменилось не только имя, но и местоположение, то можно заменить весь путь
  ReplaceAllPath = MsgBox("Заменять весь путь? Нажмите ""Нет"", чтобы заменить только имя файла", vbYesNo + vbInformation, "Изменение ссылок") = vbYes
  
  NewFileName = Replace(NewFileName, "\", "\\")
  'Перебираем все поля в документе
  For Each oFld In ActiveDocument.Fields
    If oFld.Type = wdFieldLink Then 'Если поле является полем ссылки
      FieldCode = oFld.Code.Text
      If InStr(oFld.Code.Text, "Excel.Sheet") <> 0 And InStr(FieldCode, "\\" & OldFileName) <> 0 Then 'Если поле ссылается на лист Excel и на нужный файл
        If ReplaceAllPath Then 'Если нужно заменить весь путь
          StartPath = InStr(FieldCode, ":\\") - 2
          EndPath = InStr(FieldCode, "\\" & OldFileName) + Len(OldFileName) + 2
          FieldCode = Mid(FieldCode, 1, StartPath) & NewFileName & Mid(FieldCode, EndPath)
        Else 'Если нужно заменить только имя файла
          FieldCode = Replace(FieldCode, OldFileName, Mid(NewFileName, InStrRev(NewFileName, "\") + 1))
        End If
      End If
    End If
    oFld.Code.Text = FieldCode
  Next
End Sub

или на LISP

[Сергей Богатов]

Сообщение от seregas Я видел эти подшивки. Раньше я думал, что это для крупных проектов на сотни листов. Их возможностей не знаю

Тут смотри:
http://dwg.ru/dnl/5319
http://forum.dwg.ru/showthread.php?t=5111
И используй ПОИСК