[stimsa]

Имеется макрос написанный на VBA в Autocad 2008.Не могу разобраться как он работает.Помогите доступными и понятными коментами,кто может.Заранее благодарна.

Пример процедур, с помощью которых можно изменить пути к файлам внешних ссылок и перезагрузить их.

Код:

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

Option Explicit

Private Sub ChangeXrefPath(strRefPath As String)
  Dim objSelSet As AcadSelectionSet
  Dim intType(0) As Integer
  Dim varData(0) As Variant
  Dim objBlkRef As Object
  Dim objXref As AcadExternalReference

  intType(0) = 0
  varData(0) = "INSERT"
  Set objSelSet = vbdPowerSet("repathxrefs")
  objSelSet.Select acSelectionSetAll, _
  filtertype:=intType, filterdata:=varData
  For Each objBlkRef In objSelSet
    If TypeOf objBlkRef Is AcadExternalReference Then
      Set objXref = objBlkRef
      objXref.Path = strRefPath & objXref.Name & ".dwg"
    End If
  Next
  ReloadXRefs
  objSelSet.Delete
End Sub

Private Sub ReloadXRefs()
  Dim objBlk As AcadBlock
  Dim objBlks As AcadBlocks
  Set objBlks = ThisDrawing.Blocks
  For Each objBlk In objBlks
    If objBlk.IsXRef Then
      objBlk.Reload
    End If
  Next objBlk
  ThisDrawing.Regen acAllViewports
End Sub

Public Function vbdPowerSet(strName As String) As AcadSelectionSet
  Dim objSelSet As AcadSelectionSet
  Dim objSelCol As AcadSelectionSets
  
  Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
      If objSelSet.Name = strName Then
        objSelSet.Delete
        Exit For
      End If
    '//If you get the error "Automation Error"
    'At the "Next" line, it's because one the blocks
    'You just and changed, contained another Xref, and thats
    'The block you are now trying to change! The solution for
    'This problem can be found in the Project X code for our
    'Object Model extension AcadExternalReferences
    Next
  Set objSelSet = ThisDrawing.SelectionSets.Add(strName)
  Set vbdPowerSet = objSelSet
End Function

[hwd]

Код разбит на три логических блока:

1. Событие ChangeXrefPath принимает в качестве параметра строку и заменяет этой строкой путь во всех указанных (см. ниже функцию vbdPowerSet) файлах внешних ссылок, оставляя от старого пути только имя самого подключенного файла.
2. Событие ReloadXRefs выполняет перезагрузку всех подключенных внешних ссылок, с последующей регенерацией чертежа.
3. Функция vbdPowerSet фильтрует содержимое выбранного набора, оставляя только элементы того типа, имя которого указано в качестве параметра этой функции. Данная функция вызывается в событии ChangeXrefPath.

Комментарии, имеющиеся в коде, на русский сама сможешь перевести, если захочешь.

[trir]

Очередное изобретение велосипеда, ведь есть AdRefMan.exe

[hwd]

Сообщение от trir Очередное изобретение велосипеда

Полностью согласен. Велосипедостроение обусловлено незнанием "родного" функционала по работе с сылками, доступного в AutoCAD по умолчанию.
2 stimsa
Если надоест чесать ухо ногой, рекомендую ознакомиться хотя бы с этим и этим. Во всяком случае тот велосипед, который решается в выше указанном коде, совершенно не нужен и на видео, помимо прочего, показано как сие решить "родными" средствами автокада. Мои пользователи вроде смогли разобраться (из тех, кто смотрел). Так что, было бы желание...

[stimsa]

Проблема просто в следующем:у меня имеется 10 000 внешних ссылок и один главный чертеж.Необходимо изменить путь этих внешних ссылок.Для этого мне необходимо было понять как работает данный макрос,чтобы переделать под свою задачу.
Как вы понимаете средствами автокада менять путь к 10 000 внешних ссылок-затруднительно.


P.S. Спасибо за подробный разъяснения.

[trir]

Сообщение от stimsa имеется 10 000 внешних ссылок

- Что там такое ???

[hwd]

Сообщение от stimsa у меня имеется 10 000

Ну это вряд ли, что 10 000.

Сообщение от stimsa Как вы понимаете средствами автокада менять путь к 10 000 внешних ссылок-затруднительно.

Нет не понимаю. Я точно знаю, что воспользовавшись ProjectName вы за секунду переназначите нужный путь сразу всем 10 000-м ссылкам. Но дело ваше - можете и с VBA колдовать.

[stimsa]

Сообщение от hwd Ну это вряд ли, что 10 000. Нет не понимаю. Я точно знаю, что воспользовавшись ProjectName вы за секунду переназначите нужный путь сразу всем 10 000-м ссылкам. Но дело ваше - можете и с VBA колдовать.

А где там ProjectName?

[hwd]

Сообщение от stimsa А где там ProjectName?

Я ссылки кому выше давал? Если лень смотреть, то в AutoCAD жмите F1 и набирайте в строке поиска "ProjectName".

[stimsa]

Простите.Криворукая я немного.

Извините за наглость.Не подскажите,где в вышеизложенном макросе,мне сделать следующее.У меня есть путь внешней ссылки C:\autocad\"Панель.dwg" а его надо заменить на "D:\Проекты\"Панель.dwg" и таких ссылок много.

[hwd]

Из каких соображений не желаете ProjectName воспользоваться?

[stimsa]

Да я то может и с радостью воспользовалась,но преподаватель суровый человек.Так подскажите как?

[hwd]

Пожалуй я воздержусь от дальнейших комментариев, а то достанется и преподавателю, который через одно место решает типовые задачи, и талантливому ученику.

[stimsa]

Спасибо за участие.Буду дальше морочить себе голову

[trir]

ChangeXrefPath("D:\Проекты\Панель.dwg")

Set objSelSet = vbdPowerSet("C:\autocad\Панель.dwg")

[stimsa]

Спасибо огроменное!!!!

Только ошибку выдает на вот этом месте
Private Sub ChangeXrefPath("D:\Проекты\Панель.dwg")

Compile error:
Expected:identifier

Ой спасибо,сама уже разобралась.

[trir]

Учить VBA!!!

[stimsa]

Вроде как правильно все делаю,но пути не меняются почему-то

Код:

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

Option Explicit

Private Sub ChangeXrefPath(strRefPath As String)
  Dim objSelSet As AcadSelectionSet
  Dim intType(0) As Integer
  Dim varData(0) As Variant
  Dim objBlkRef As Object
  Dim objXref As AcadExternalReference

  intType(0) = 0
  varData(0) = "INSERT"
  Set objSelSet = vbdPowerSet("D:\Архив\51226900F0-1401 ТН ячейка\51226921F0-07 Блок трансформаторов напряжения\51226921F0-06 Привод трансформаторов напряжения\51226921F0-05 Корпус")
  objSelSet.Select acSelectionSetAll, _
  filtertype:=intType, filterdata:=varData
  For Each objBlkRef In objSelSet
    If TypeOf objBlkRef Is AcadExternalReference Then
      Set objXref = objBlkRef
      objXref.Path = strRefPath & objXref.Name & ".dwg"
    End If
  Next
  ReloadXRefs
  objSelSet.Delete
End Sub

Private Sub ReloadXRefs()
  Dim objBlk As AcadBlock
  Dim objBlks As AcadBlocks
  Set objBlks = ThisDrawing.Blocks
  For Each objBlk In objBlks
    If objBlk.IsXRef Then
      objBlk.Reload
    End If
  Next objBlk
  ThisDrawing.Regen acAllViewports
End Sub

Public Function vbdPowerSet(strName As String) As AcadSelectionSet
  Dim objSelSet As AcadSelectionSet
  Dim objSelCol As AcadSelectionSets
  
  Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
      If objSelSet.Name = strName Then
        objSelSet.Delete
        Exit For
      End If
    Next
  Set objSelSet = ThisDrawing.SelectionSets.Add(strName)
  Set vbdPowerSet = objSelSet
End Function

Sub a()

ChangeXrefPath ("D:\autocad")

End Sub

[trir]

Для начала проверь правильность работы функции vbdPowerSet