[ramber]

Добрый день!

Для выбора блоков с чертежа обычно пользуюсь AcadSelectionSets. Но в таком случае нужно самому выделять область для поиска блоков.

Есть ли способ создать набор из всех блоков одного имени не прибегая к выбору чего-то с чертежа?

[Кулик Алексей aka kpblc]

Можно. Проходишь по блоку текущего пространства и собираешь нужные тебе элементы.
Или, опять же, в SelectionSets есть, насколько я помню, нечто типа SelectAll - посмотри документацию.

[ramber]

Сообщение от Кулик Алексей aka kpblc Или, опять же, в SelectionSets есть, насколько я помню, нечто типа SelectAll - посмотри документацию.

Получилось! Спасибо!

Можно узнать твой номер счета / карты, ты очень во много мне помог, хотелось бы поблагодарить чем-нибудь посущественнее "спасибо"

[Кулик Алексей aka kpblc]

Не выдумывай

[AlexV]

Товарищи, сто лет не программировал, подскажите.. Задачка - быстро убить все вхождения блока в файле. SelectBlock впихивает в набор все динблоки, если "varData(1) = "`*U*," & name_Blck", либо - если "varData(1) = "name_Blck" - не включает нужный динблок. Приходится перебирать и проверять по EffectiveName. Нет ли какого способа более грамотного - собрать все вхождения динблока в файле на корабль и разом утопить?
А еще - если не игнорить ошибки "On Error Resume Next", при удалении блоков вылазит

Код:

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

  
On Error Resume Next 
       Set varSelBl = SelectBlock()
        For Each tmpinsBl In varSelBl
         If tmpinsBl.EffectiveName = name_Blck Then
            tmpinsBl.Delete
         End If
        Next

Private Function SelectBlock() As AcadSelectionSet
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Dim intType(1) As Integer
Dim varData(1) As Variant
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
 If objSelSet.Name = "block" Then
  objSelSet.Delete
  Exit For
 End If
Next
Set objSelSet = ThisDrawing.SelectionSets.Add("block")
intType(0) = 0 '
varData(0) = "INSERT" '
intType(1) = 2 '
varData(1) = "`*U*," & name_Blck '
objSelSet.Select acSelectionSetAll, , , intType, varData
Set SelectBlock = objSelSet
End Function

[Сергей812]

В .Net без циклов тоже не обойтись )

[AlexV]

А подскажите, вот такая конструкция фильтра вроде работает, собирает в коллекцию таблицы из пространства модели.

Код:

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

Dim intType(1) As Integer
Dim varData(1) As Variant
intType(0) = 0 '
varData(0) = "ACAD_TABLE" '
intType(1) = 410
varData(1) = "Model"

А можно ли аналогично получить коллекцию из таблиц в пространстве листа (на всех листах, вместе взятых)?

[baksconstructor]

Сообщение от AlexV А можно ли аналогично получить коллекцию из таблиц в пространстве листа (на всех листах, вместе взятых)?

Сделать список листов через запятую и подсунуть в строку
varData(1) = сюды

[AlexV]

Сообщение от baksconstructor Сделать список листов через запятую и подсунуть в строку varData(1) = сюды

спасиб, попробую!

А не подскажите по этому коду:

Код:

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

Set varSelBl = SelectBlock()
        For Each tmpinsBl In varSelBl
         If tmpinsBl.EffectiveName = name_Blck Then
            tmpinsBl.Delete
         End If
        Next

поштучно расстреливаю членов коллекции, но - я так понимаю, если попытаться убить последнего члена, вылазит ошибка..

[baksconstructor]

Сообщение от AlexV если попытаться убить

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

[AlexV]

Сообщение от baksconstructor Зачем ? удялете из чертежа ? Тогда лучше вырезать, насколько помню .erase

с еrase та же ошибка..

[baksconstructor]

или весь код или хотяб принтскрины дайте

[AlexV]

Сообщение от baksconstructor или весь код или хотяб принтскрины дайте

как то так:

Код:

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

sub main()

 Dim tmpvar, varSelBl As AcadSelectionSet, tmpinsBl As AcadEntity 'AcadBlockReference

 'On Error Resume Next
 name_Blck = "x123"
 returnReal = 1
 returnReal = ThisDrawing.Utility.GetReal("1 али 0?")

If returnReal = 0 Then
       Set varSelBl = SelectBlock()
        For Each tmpinsBl In varSelBl
         If tmpinsBl.EffectiveName = name_Blck Then
            tmpinsBl.Erase '.Delete
         End If
        Next
Else
 '****
End if
'****
End sub()


Private Function SelectBlock() As AcadSelectionSet
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Dim intType(1) As Integer
Dim varData(1) As Variant
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
 If objSelSet.Name = "block" Then
  objSelSet.Delete
  Exit For
 End If
Next
Set objSelSet = ThisDrawing.SelectionSets.Add("block")
intType(0) = 0 '
varData(0) = "INSERT" '
intType(1) = 2 '
varData(1) = "`*U*," & name_Blck ' 
objSelSet.Select acSelectionSetAll, , , intType, varData
Set SelectBlock = objSelSet
'Stop
End Function

[maratovich]

А как это вообще у вас работает ?

1.поставьте отдельно от всего (сверху)
Dim name_Blck as String

2. Проверил на 2013 , всё нормально обработало, никакой ошибки не выдало, удалило все боки.
Думаю что у вас в настройках не того... посмотрите принткрин, проверьте.

[Сергей812]

Сообщение от maratovich 1.поставьте отдельно от всего (сверху) Dim name_Blck as String

тогда уж напомнить об Option Explicit )

[AlexV]

Сообщение от Сергей812 тогда уж напомнить об Option Explicit )

Спасибо, да не, не в этом дело.. я просто избирательно скопировал, переменные все объявлены.. И если какой косяк с объявлением переменных, vba об этом скажет сразу, до начала исполнения модуля. А тут ругается за какое-то "нарушение блокировки"..

И галка на "err trap" стоит там же..

[maratovich]

Вы сперва этот отдельный код проверьте (с форума), если оно работает, то значит в других строках проблема.
Или в другом файле, или переустановить vba....

[Сергей812]

AlexV, не вы первый с этой ошибкой на форуме)