• Откуда: Забайкалье / Чита
  • На форуме с 3 апреля 2009г.
  • Сообщений: 33
  • Спасибо: 0

Тема: Удаление описания блока из чертежа

Здравствуйте.
Только начал разбираться с блоками.
Я пишу прогу на VBA под ACAD, в которой как я понял сначала создается описание блока

    ' cоздание блока координатного крестика - его описание в чертеже
    Dim blockObj As AcadBlock
    AcadPoint(0) = 0:    AcadPoint(1) = 0:    AcadPoint(2) = 0
    Set blockObj = ThisDrawing.Blocks.Add(AcadPoint, "КрестXY") ' описание блока - базовая точка и имя
        blockObj.Units = acInsertUnitsMillimeters               ' единицы блока - миллиметры
        ' состав блока
            Bpnt(0) = -3:  Bpnt(1) = 0:  Bpnt(2) = 0 ' гоизонтальная линия
            Epnt(0) = 3:   Epnt(1) = 0:  Epnt(2) = 0
        Set lin = blockObj.AddLine(Bpnt, Epnt)
            lin.Layer = NameLayerKoorSetka
            Bpnt(0) = 0:  Bpnt(1) = -3:  Bpnt(2) = 0 ' вертикальная линия
            Epnt(0) = 0:   Epnt(1) = 3:  Epnt(2) = 0
        Set lin = blockObj.AddLine(Bpnt, Epnt)
            lin.Layer = NameLayerKoorSetka

а потом на чертеж в цикле делается вставка блока по имени в нужной точке

    ' переменная для вставки блока на чертеж acAny acInsertUnitsUnitless
    Dim blockRefObj As AcadBlockReference
for
   ' Вставка блока на чертеж в точке с именем, масштабом по осям и углом поворота
   Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(AcadPoint, "КрестXY", 1#, 1#, 1#, AngRot)
       blockRefObj.Layer = NameLayerKoorSetka
next

С этим я разобрался. В результате работы моей проги на чертеже будет создано множество блоков и с разными именами в зависимости от исходных данных. Специфика моей работы такова, что этот чертеж нужно будет перестраивать при обнаружении ошибок на предыдущей итерации построения чертежа, т.е. возникает варианта два:
1. новая версия чертежа будет построена в новом чистом документе ACAD (все здорово, но мне это не нравится, т.к. перед построением чертежа мне нужно его сохранить с пустым содержанием, чтобы по пути его сохранения определить откуда взять данные для построения самого чертежа, потому что не хочу вызывать диалог, откуда брать данные);
2. в существующем документе ACAD сделать откат назад или просто стереть то, что было построено и запустить прогу построения новой версии чертежа (это мне очень удобно).
Но если с исходными данными было что-то не так, то в документе ACAD появятся описания блоков с неправильными именами, которые я хотел бы удалить программно (а самих вхождений блоков на чертеж нет).

Отсюда вопрос. Я хотел бы написать процедуру удаления описаний всех блоков (чтобы каждый раз не выполнять команду меню ACAD "Файл\Утилиты\Очистить") и вставить эту процедуру в мою прогу перед построением чертежа. В этом случае бы уже в окончательно готовом чертеже не было бы описания не нужных блоков.
Как мне это сделать, подскажите пожалуйста. По поиску посмотрел - нашел процедуры, которые только удаляют вхождения блоков, а описания не удаляют.

  • Vildar
  • Активный участник
  • Откуда: Саратов
  • На форуме с 15 августа 2008г.
  • Сообщений: 574
  • Спасибо: 11

Re: Удаление описания блока из чертежа

ThisDrawing.Blocks("ИмяБлока").Delete

Если вхождений этого блока в чертеже нет, то он удалится.

  • Откуда: Забайкалье / Чита
  • На форуме с 3 апреля 2009г.
  • Сообщений: 33
  • Спасибо: 0

Re: Удаление описания блока из чертежа

Спасибо. При использовании функции https://www.caduser.ru/forum/post235825.html#p235825 все получилось.
Эта функция удаляет как вставки блоков, так и их описания.

  • Откуда: Санкт-Петербург
  • На форуме с 24 октября 2008г.
  • Сообщений: 19
  • Спасибо: 0

Re: Удаление описания блока из чертежа

Несколько другой угол зрения. Практически в каждом чертеже, который попадает ко мне от самых разных исполнителей очень много "грязи", в том числе блоки стерты, а описания остались, пустые слои и т.д. и т.п.
Поэтому я начинаю многие свои макросы с Call ClearDrawing.
Function ClearDrawing()
    Call DeleteEmptyText3 'удаление текстовых объектов с пустым Caption
    ThisDrawing.PurgeAll 'удаление неиспользуемых в чертеже:
                            'блоков
                            'стилей размеров
                            'слоев
                            'типов линий
                            'стилей мультилиний
                            'PlotStyles
                            'Shapes
                            'стилей таблиц
                            'стилей текстов
End Function
Function DeleteEmptyText3()
    Dim Elem As Object
    Dim entry As AcadEntity
    Dim MyTxt As AcadText
    For Each Elem In ThisDrawing.ModelSpace
        If Elem.EntityName = "AcDbText" Then
            Set MyTxt = Elem
            Set entry = Elem
            If Trim(MyTxt.TextString) = "" Then entry.Delete
        End If
    Next
End Function

  • Boxa
  • Активный участник
  • Откуда: С-Пб
  • На форуме с 25 июля 2009г.
  • Сообщений: 135
  • Спасибо: 11

Re: Удаление описания блока из чертежа

Валерий Тимаков пишет:

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

Поэтому я начинаю многие свои макросы с Call ClearDrawing.

Очень хорошая функция, только я бы в набор добавил бы еще одну  :) .
Удаление линий и полилиний с нулевой длиной.

Sub DeleteNullLine()
    Dim Elem As Object
    Dim entry As AcadEntity
    For Each Elem In ThisDrawing.ModelSpace
        If Elem.EntityName = "AcDbLine" Or Elem.EntityName = "AcDbPolyline" Then
            Set entry = Elem
            If entry.Length = 0 Then entry.Delete
        End If
    Next
End Sub

  • Откуда: Забайкалье / Чита
  • На форуме с 3 апреля 2009г.
  • Сообщений: 33
  • Спасибо: 0

Re: Удаление описания блока из чертежа

Спасибо, я тоже это буду применять в моей работе

  • Откуда: Санкт-Петербург
  • На форуме с 24 октября 2008г.
  • Сообщений: 19
  • Спасибо: 0

Re: Удаление описания блока из чертежа

Цитата
Boxa Shu пишет: "...я бы в набор добавил бы еще одну.
Удаление линий и полилиний с нулевой длиной."

Спасибо. Принимаю дополнение с небольшой поправкой: Вместо Sub сделаю Function. Дело в том, что Sub Public и без параметров "загрязняет" встроенное диалоговое окно "Макросы"...

  • Откуда: Санкт-Петербург
  • На форуме с 24 октября 2008г.
  • Сообщений: 19
  • Спасибо: 0

Re: Удаление описания блока из чертежа

И ещё. Встретились тексты с лишними пробелами между словами. Поэтому заменил Function DeleteEmptyText3 на correctTexts3.
Function correctTexts3()'Корректировка текстовых объектов, то есть удаление объектов с пустым Caption или лишних пробелов 
    Dim Elem As Object, MyTxt As AcadText
    For Each Elem In ThisDrawing.ModelSpace
        If Elem.EntityName = "AcDbText" Then
            Set MyTxt = Elem
            If Trim(MyTxt.TextString) = "" Then
                MyTxt.Delete
            Else
                MyTxt.TextString = impactText3(MyTxt.TextString)
                MyTxt.Update
            End If
        End If
    Next
End Function

Function impactText3(tBase$) As String  ' Удаление лишних пробелов в тексте
    Dim temp1$, temp2$
    temp1 = tBase
    Do
        temp2 = temp1
        temp1 = Replace(temp1, Space(2), Space(1))
    Loop Until temp2 = temp1
    impactText3 = Trim(temp1) ' удаление лишних пробелов в начале и конце
End Function

  • fixo
  • fixo
  • Активный участник
  • Откуда: СПб
  • На форуме с 7 февраля 2009г.
  • Сообщений: 869
  • Спасибо: 41

Re: Удаление описания блока из чертежа

Используй лучше это 

If TypeOf Elem Is AcadText Then '<-- без кавычек

вместо

If Elem.EntityName = "AcDbText" Then

[FONT=Arial]~'J'~[/FONT]