удалить блок из набора/выбора блоков

Автор Тема: удалить блок из набора/выбора блоков  (Прочитано 2760 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Тема содержит сообщение с Решением. Нажмите здесь чтобы посмотреть его.

Оффлайн wavawАвтор темы

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
здравствуйте.
делаю набор блоков выбором с помощью:
Код - Visual Basic [Выбрать]
  1. ThisDrawing.SelectionSets("SS").Delete
  2. Set ss = ThisDrawing.SelectionSets.Add("SS")
  3. ss.SelectOnScreen
как из этого набора удалить все анонимные блоки вида *U.. (*U126, *U154 и т.д.)?

для команды delete в справке написано, что для удаления по итемам нужно использовать
ThisDrawing.Groups.Item("group1").Delete
но тут имя задаётся четко.
у меня же оно варьируется от открытия к открытию чертежа.

можно и полностью удалить эти блоки *U.. если подскажите как



« Последнее редактирование: 27-04-2017, 12:53:35 от Александр Ривилис »

Оффлайн Владимир Шу

  • ADN Club
  • ****
  • Сообщений: 409
  • Карма: 90
Код - Visual Basic [Выбрать]
  1. Sub srgha()
  2.     AppActivate ThisDrawing.Application.Caption
  3.     Dim ssetObj As AcadSelectionSet
  4.     ThisDrawing.SelectionSets("TEST_SSET").Delete
  5.     Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET")
  6.     ssetObj.SelectOnScreen
  7.     Dim ent As AcadEntity
  8.     For Each ent In ssetObj   ' Iterate through each element.
  9.        If ent.ObjectName = "AcDbBlockReference" Then
  10.             Dim blkRef As AcadBlockReference
  11.             Set blkRef = ent
  12.             Dim blockName As String
  13.             blockName = blkRef.Name
  14.             ' если хочется именно *U
  15.            If Left(blockName, 2) = "*U" Then
  16.                 blkRef.Delete
  17.                 ThisDrawing.Utility.Prompt ("Удален блок: " & blockName & vbCrLf)
  18.             End If
  19.         End If
  20.     Next
  21. End Sub
  22.  
  23.  

Удалить все еще проще
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2. Sub srghaAll()
  3.     AppActivate ThisDrawing.Application.Caption
  4.     Dim ent As AcadEntity
  5.     For Each ent In ThisDrawing.ModelSpace
  6.         If ent.ObjectName = "AcDbBlockReference" Then
  7.             Dim blockName As String
  8.             blockName = ent.Name
  9.             'если хочется именно *U
  10.            If Left(blockName, 2) = "*U" Then
  11.                 ent.Delete
  12.                 ThisDrawing.Utility.Prompt ("Удален блок: " & blockName & vbCrLf)
  13.             End If
  14.         End If
  15.     Next
  16. End Sub

Оффлайн wavawАвтор темы

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
"ядрёный" код!

удаляет то, что мне сохранить хочется (Mega Ramka). Блоки с *U тоже подчистую.
а мега рамка удаяется потому, что блок *У  как-то у неё встроен?


Оффлайн Владимир Шу

  • ADN Club
  • ****
  • Сообщений: 409
  • Карма: 90
Я не очень понял что Вы спрашиваете.
Все динамические блоки, если их меняли (дергают за ручки и т.п.), имеют имя *U
Вероятно у Вас рамка так же сделана дин. блоком, потому и удаляется.

Вы лучше напишите что Вы хотите сделать.

Оффлайн wavawАвтор темы

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
код с соседнего поста тестирую. заключается в том, что необходимо выбрать все примитивы на чертеже (модель) и после код начинает печатать только форматы названные "блок А3".
у меня же есть такой блок (форматка). он динамический. может растягиваться как угодно и можно выбором задавать определенные размеры. называется мой блок "Мега рамка".

соответственно я делаю выбор всех примитивов:

Код - Visual Basic [Выбрать]
  1. ThisDrawing.SelectionSets("SS").Delete
  2.     Set ss = ThisDrawing.SelectionSets.Add("SS")
  3.     ss.SelectOnScreen
  4.  
далее фильтрую по имени:

Код - Visual Basic [Выбрать]
  1. For Each objEnt In ss
  2.     If objEnt.ObjectName = "AcDbBlockReference" Then
  3.     Set objBRef = objEnt
  4.     BlockProp = objBRef.GetDynamicBlockProperties
  5.         If objBRef.EffectiveName = "Mega Ramka" And BlockProp(5).Value = "А3 книжная" Then

но беда в том, что под этот выбор пролазят блоки с *U и печатаются форматы с неверной точкой отсчета.
вот думаю, как это обойти. и, как вариант, интересуюсь можно ли эти *U удалить
« Последнее редактирование: 27-04-2017, 20:46:17 от Александр Ривилис »

Оффлайн Владимир Шу

  • ADN Club
  • ****
  • Сообщений: 409
  • Карма: 90
Отсеять то не сложно, но толку то...
Код - Visual Basic [Выбрать]
  1. If objBRef.EffectiveName = "Mega Ramka" And BlockProp(5).Value = "А3 книжная" And Left( objBRef.Name, 2) <> "*U" Then

Я же писал, любой динамический блок, если его подергать за ручки будет иметь имя *U, в том числе и "правильный" (нужный Вам), так что Вам нужно подумать и анализировать какие то другие параметры...
Складывается впечатление, что Вы не очень представляете как работает автокад с дин. блоками. ИМХО, советы будут более полные, если выложить весь код и файл пример с рамками...

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 8395
  • Карма: 1012
  • Рыцарь ObjectARX
  • Skype: rivilis
wavaw
Прочитайте у меня в подписи как форматировать код на форуме и придерживайтесь этого правила!
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн wavawАвтор темы

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
как ни странно, но всё отлично работает. даже если не очищать от блоков *U
стоило из чертежа удалить все массивы
чертеж с кодом приложу. так как без массивов чертежи вряд ли будут. а с ними код не работает правильно.

впечатление верное. видеоролик, по которому делаю печать, был для начинающих и на такой подвох с блоками (теперь уже с массивами) я не рассчитывал.

http://fex.net/843120514818

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 764
  • Карма: 120
Насколько я помню, массивы бывают двух видов - классические и динамические. Дин.массив с точки зрения программирования - тот же блок.
Может, так сработает?
Код - Visual Basic [Выбрать]
  1. Option Explicit
  2.  
  3. Public Sub test()
  4. Dim ent As AcadEntity
  5. Dim selset As AcadSelectionSet
  6. Dim ssName As String
  7. Dim filterData As Variant, filterType As Variant
  8.   ssName = "adncis"
  9.   On Error Resume Next
  10.   ThisDrawing.SelectionSets.Item(ssName).Delete
  11.  
  12.   filterType(0) = 0
  13.   filterData(0) = "INSERT"
  14.  
  15.   Set selset = ThisDrawing.SelectionSets.Add(ssName)
  16.   selset.SelectOnScreen filterType, filterData
  17.    
  18.   For Each ent In selset
  19.     If Left(ent.Name, 2) = "*U" Then
  20.       selset.RemoveItems ent
  21.     End If
  22.   Next
  23.  
  24. End Sub
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн wavawАвтор темы

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
Алексей Кулик,
не удаётся проверить правильность. vba просто игнорит присвоение фильтра


Код - Visual Basic [Выбрать]
  1. ' 3. Batch printing of specific blocks-formats
  2. Sub PlotByBlocks()
  3.  
  4. '    Dim objEnt As AcadEntity
  5.    Dim objBRef As AcadBlockReference
  6.     Dim pt1 As Variant
  7.     Dim pt2(0 To 1) As Double
  8.     Dim i As Integer
  9.  
  10.     ' Create a selection with a frame
  11.    
  12.     On Error Resume Next
  13. Dim ent As AcadEntity
  14. Dim selset As AcadSelectionSet
  15. Dim ssName As String
  16. Dim filterData As Variant, filterType As Variant
  17.   ssName = "adncis"
  18.   On Error Resume Next
  19.   ThisDrawing.SelectionSets.Item(ssName).Delete
  20.  
  21.   filterType(0) = 0
  22.   filterData(0) = "INSERT"
  23.   i = i + 1
  24.  
  25.   Set selset = ThisDrawing.SelectionSets.Add(ssName)
  26.   selset.SelectOnScreen filterType, filterData
  27.    
  28.   For Each ent In selset
  29.     If Left(ent.Name, 2) = "*U" Then
  30.       selset.RemoveItems ent
  31.     End If
  32.   Next
  33.  
  34.     'ThisDrawing.SelectionSets("SS").Delete
  35.    'Set ss = ThisDrawing.SelectionSets.Add("SS")
  36.    'ss.SelectOnScreen
  37.        
  38.     ' We work if the name of the A1 block
  39.    i = 0
  40.     For Each ent In selset
  41.     If ent.ObjectName = "AcDbBlockReference" Then
  42.     Set objBRef = ent
  43.     BlockProp = objBRef.GetDynamicBlockProperties
  44.         If objBRef.EffectiveName = "Mega Ramka" And BlockProp(4).Value = "A3-a" And Left(objBRef.EffectiveName, 2) <> "*U" Then
  45.             pt1 = objBRef.InsertionPoint
  46.             pt1 = ThisDrawing.Utility.TranslateCoordinates(pt1, acWorld, acDisplayDCS, False)
  47.             ReDim Preserve pt1(0 To 1)
  48.             pt2(0) = pt1(0) + 42000
  49.             pt2(1) = pt1(1) + 29700
  50.             i = i + 1
  51.             PolyPlot "c:\Users\wavaw\Desktop\À3_" + CStr(i), pt1, pt2
  52.         End If
  53.     End If
  54.     Next
  55.    
  56. End Sub
  57. Sub PolyPlot(strFileName As String, pt1 As Variant, pt2 As Variant)
  58.  
  59.     ' We declare
  60.    Dim Layout As AcadLayout
  61.          
  62.     ' Setting
  63.    Set Layout = ThisDrawing.ActiveLayout
  64.        
  65.     Layout.RefreshPlotDeviceInfo
  66.            
  67.     ' Print Settings
  68.    Layout.ConfigName = "DWG to PDF.pc3"
  69.     Layout.CanonicalMediaName = "ISO_full_bleed_A3_(420.00_x_297.00_MM)"
  70.     Layout.CenterPlot = True
  71.     Layout.PlotRotation = ac0degrees
  72.     Layout.StandardScale = acScaleToFit
  73.     Layout.StyleSheet = "monochrome.ctb"
  74.    
  75.     ' We set the frame and type of window
  76.    Layout.SetWindowToPlot pt1, pt2
  77.     Layout.PlotType = acWindow
  78.    
  79.     ' We send to the press
  80.    ThisDrawing.Regen acAllViewports
  81.     ThisDrawing.Plot.PlotToFile strFileName
  82.        
  83. End Sub

Оффлайн Алексей Кулик

  • Administrator
  • *****
  • Сообщений: 764
  • Карма: 120
Я просто показал, как из набора можно "убрать" объект, отвечающий определенным требованиями. Сугубо ИМХО: тебе надо проверять именно эффективное имя блока.
Кстати, строкаIf ent.ObjectName = "AcDbBlockReference" Thenпо идее лишняя - в набор и так попадают только блоки. Советую пошагово пройти по коду и посмотреть, что и когда появляется и исчезает из набора. Я убежден, что в наборе сначала есть все, но последующая операция selset.RemoveItem убирает как лишнее, так и нужное. Меняй критерии убирания объектов из набора.
Все, что сказано - личное мнение.

Правила форума существуют не просто так!

Приводя в сообщении код, не забывайте про его форматирование!

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 8395
  • Карма: 1012
  • Рыцарь ObjectARX
  • Skype: rivilis
Насколько я помню в цикле по набору нельзя удалять элементы набора.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн wavawАвтор темы

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
Александр Ривилис,

вы скорее всё же правы. не выходит удалить эти элементы набора.
придётся пользоваться "костылём" и выделять заведомо только нужные блоки-рамки. тогда работает как надо.

Отмечено как Решение wavaw 30-04-2017, 08:05:27

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 8395
  • Карма: 1012
  • Рыцарь ObjectARX
  • Skype: rivilis
вы скорее всё же правы. не выходит удалить эти элементы набора.
Всё проще. Нужно создать массив удаляемых элементов, заполнить его в цикле по элементам набора, а затем в цикле по элементам массива удалять их из набора.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн wavawАвтор темы

  • ADN OPEN
  • Сообщений: 21
  • Карма: 0
заработало!
двумя переборами вычленил только то, что мне необходимо "загонять" на печать
   
Код - Visual Basic [Выбрать]
  1.  ThisDrawing.SelectionSets("SS").Delete
  2.     Set ss = ThisDrawing.SelectionSets.Add("SS")
  3.     ss.SelectOnScreen
  4.    
  5.     i = 0
  6.     For Each objEnt In ss
  7.         ReDim Preserve arr(i)
  8.         Set arr(i) = objEnt
  9.         i = i + 1
  10.     Next
  11.    
  12.     i = 0
  13.     k = 0
  14.     For i = LBound(arr) To UBound(arr)
  15.        If arr(i).Layer = "Vramka" Then
  16.             ReDim Preserve arr2(k)
  17.             Set arr2(k) = arr(i)
  18.             k = k + 1
  19.        End If
  20.     Next
« Последнее редактирование: 30-04-2017, 08:05:17 от wavaw »