| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP. Очистка рисунка от "пустых" блоков

LISP. Очистка рисунка от "пустых" блоков

Ответ
Поиск в этой теме
Непрочитано 12.03.2009, 16:38 1 | #1
LISP. Очистка рисунка от "пустых" блоков
Makswell
 
Инженер-строитель
 
Киров
Регистрация: 15.08.2007
Сообщений: 2,204

Программа удаляет из рисунка все вхождения "пустых блоков", т.е. блоков, которые не содержат примитивов. Такие блоки не выделяются рамкой, но их можно выделить с помощью _qselect. Также из рисунка удаляются сами описания этих блоков. Может кому пригодится.
Код:
[Выделить все]
(defun C:PurgEmptyBlk
       (/ adoc fam_Blocks blk_name lst selset sel_len i ent j)
;;;  очистка рисунка от "пустых" блоков
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  )
  (setq	lst '()
	fam_Blocks
	 (vla-get-Blocks adoc)
  )
  ;;получение списка имён "пустых" блоков
  (vlax-for fam_item fam_Blocks
    (setq blk_name (vla-get-Name fam_item))
    (if
      (and (not	(or (= (substr blk_name 1 1) "*")
		    (= (substr blk_name 1 1) "_")
		)
	   )
	   (= (vla-get-Count fam_item) 0)
      )
       (setq lst (cons blk_name lst))
    )
  )
  ;;удаление вхождений "пустых" блоков
  (if lst
    (progn
      (setq selset (ssget "_X" (list (cons 0 "INSERT"))))
      (if selset
	(progn
	  (setq	i	0
		j	0
		sel_len	(sslength selset)
	  )
	  (while (/= i sel_len)
	    (setq ent (vlax-ename->vla-object (ssname selset i)))
	    (if	(member (vla-get-EffectiveName ent) lst)
	      (progn
		(vla-Delete ent)
		(setq j (1+ j))
	      )
	    )
	    (setq i (1+ i))
	  )
	)
      )
      ;;удаление описаний "пустых" блоков
      (foreach item lst
	(vla-Delete (vla-Item fam_Blocks item))
      )
    )
  )
  (vla-endundomark adoc)
  (princ "\nУдалено вхождений \"пустых\" блоков: ")
  (princ (if j
	   j
	   "0"
	 )
  )
  (princ "\nУдалено описаний \"пустых\" блоков: ")
  (princ (length lst))
;;; добавлено 2015-09-10 начало
  (if (not (= (length lst) 0))
    (progn
      (princ "\nИмена удалённых блоков: ")
      (foreach item lst
	(terpri)
	(princ item)
      )
    )
  )
;;; добавлено 2015-09-10 конец
  (princ)
)

Последний раз редактировалось Makswell, 10.09.2015 в 14:07. Причина: Немного изменил код.
Просмотров: 10157
 
Непрочитано 12.03.2009, 18:06
#2
Sleekka

-
 
Регистрация: 24.07.2005
Москва
Сообщений: 1,335


Спасибо. Полезненько.
Sleekka вне форума  
 
Непрочитано 12.03.2009, 22:21
1 | #3
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


http://jtbworld.com/lisp/purger.htm ну и до кучи http://jtbworld.com/lisp/PurgeReconciledLayers.htm
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 13.03.2009, 09:01
#4
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Алексей, там вроде бы нет удаления "пустых" блоков.

PS Немного изменил код в первом посте. Добавил вывод в ком. строку результатов работы программы.
Makswell вне форума  
 
Непрочитано 13.03.2009, 10:45
#5
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Makswell, ну извини. Я хотел показать некоторые дополнительные моменты.
Кстати! А как ты собираешься поступать с блоками, у которых есть только атрибут, а его значение не заполнено? А что делать, если "пустой" блок входит внутрь другого? И почему б не провести дополнительную фильтрацию на внешние ссылки? А что делать, если внутри блока текст (однострочный или многострочный) с пустым содержанием или сплошными пробелами? А если внутри блока только "пустой" блок? Так что тут, мне думается, задачка будет достаточно сложной в результате...
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 13.03.2009, 11:00
#6
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Offtop: Эээ... Надо подумать
Makswell вне форума  
 
Непрочитано 13.03.2009, 11:11
#7
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Добавлю: для многострочных текстов и атрибутов придется по ходу дела сносить форматирование тоже задачка не самая элементарная (хотя на форуме решения были).
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.03.2009, 11:12
1 | #8
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,439
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Makswell, ну извини. Я хотел показать некоторые дополнительные моменты.
Кстати! А как ты собираешься поступать с блоками, у которых есть только атрибут, а его значение не заполнено? А что делать, если "пустой" блок входит внутрь другого? И почему б не провести дополнительную фильтрацию на внешние ссылки? А что делать, если внутри блока текст (однострочный или многострочный) с пустым содержанием или сплошными пробелами? А если внутри блока только "пустой" блок? Так что тут, мне думается, задачка будет достаточно сложной в результате...
Хотелось бы добавить, что не всегда стоит удалять эти блоки. Некоторые программы, создают такие блоки, для хранения своей информации, например в расширенных данных. Другими словами, есть пустой блок, содержащий не графическую информацию, необходимую для сохранения некоторых настроек программы. Как пример, accurender - хранит настройки текстур, направлений источников света и многое другое, в обычных блоках, иногда пустых, но с расширенными данными. Кстати, я слышал, что некоторые программы, сохраняют некоторую информацию, просто в названии пустого блока и заодно, блокируют им слой вставки...
__________________
Чем гениальнее ваш план, тем меньше людей с ним будут согласны.
/Сунь Цзы/
Елпанов Евгений вне форума  
 
Непрочитано 10.05.2011, 09:15
#9
Farest-1

Конструктор
 
Регистрация: 19.12.2005
Подольск
Сообщений: 54
<phrase 1= Отправить сообщение для Farest-1 с помощью Skype™


Команда: PurgEmptyBlk
; ошибка: Ошибка Automation. На объект имеется ссылка
Farest-1 вне форума  
 
Автор темы   Непрочитано 10.05.2011, 12:26
#10
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Farest-1, выложи файл, где проявляется эта проблема.

PS По случаю подправил код в посте 1, убрав небольшие несущественные косяки.
Makswell вне форума  
 
Непрочитано 10.09.2015, 10:56
#11
qazse


 
Регистрация: 14.03.2010
Сообщений: 2


Очень полезная программка, можно добавить сюда список удаленных блоков? чтобы в итоге было видно что удалилось.
qazse вне форума  
 
Автор темы   Непрочитано 10.09.2015, 14:08
#12
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


qazse, допилил код в первом посте.
Makswell вне форума  
 
Непрочитано 10.09.2015, 14:31
#13
qazse


 
Регистрация: 14.03.2010
Сообщений: 2


Все отлично работает! еще раз спасибо

----- добавлено через ~12 мин. -----
А есть еще такая возможность чтобы он вначале выводил список всех блоков в том числе пустых и не пустых их количество, а потом предлагал выбрать и удалить из чертежа, включая модель и листы?
qazse вне форума  
 
Непрочитано 26.10.2022, 14:23
#14
AMDen

Инженер-проектировщик
 
Регистрация: 07.07.2016
Санкт-Петербург
Сообщений: 723


Возможно ли изменить код из поста 1 так, чтобы ещё удалялись пустые анонимные блоки?
Попробовал убрать (= (substr blk_name 1 1) "*"). Блоки удаляет, но выдаёт "Настройка переменной AutoCAD отвергнута: "CMDECHO" nil".
Предполагаю что загвоздка где-то в (vla-get-EffectiveName ent). Что делать дальше, не знаю. В лиспе практически не разбираюсь. )
AMDen вне форума  
 
Непрочитано 26.10.2022, 14:46
#15
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Как вариант, без очистки описаний блоков. И если внутри какого-то блока было одно вхождение пустого блока, то после удаления такой блок становится пустым. Я не стал делать обработку такого варианта. Лень.
P.S. Код не проверял и не тестировал.
Код:
[Выделить все]
 (vl-load-com)
(defun c:purge-empty-blocks (/ adoc layer_status name_list res_list err_list ent_name)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))


  (vlax-for blk_def (vla-get-blocks adoc)
    (if (and (equal (vla-get-islayout blk_def) :vlax-false)
             (equal (vla-get-isxref blk_def) :vlax-false)
             (= (vla-get-count blk_def) 0)
        ) ;_ end of and
    (setq name_list (cons (vla-get-name blk_def) name_list))
    ) ;_ end of if
  ) ;_ end of vlax-for

  (if (= 0 (length name_list))
    (princ "\nNothing to erase")
    (progn
      (vla-startundomark adoc)
      (vlax-for item (vla-get-layers adoc)
        (setq layer_status
               (cons
                 (cons item
                       (mapcar (function (lambda (prop / temp)
                                           (setq temp (vlax-get-property item prop))
                                           (vl-catch-all-apply
                                             (function (lambda ()
                                                         (vlax-put-property item prop :vlax-false)
                                                       ) ;_ end of lambda
                                             ) ;_ end of function
                                           ) ;_ end of vl-catch-all-apply
                                           (cons prop temp)
                                         ) ;_ end of lambda
                               ) ;_ end of function
                               '("lock"
                                 "freeze"
                                )
                       ) ;_ end of mapcar
                 ) ;_ end of cons
                 layer_status
               ) ;_ end of cons
        ) ;_ end of setq
      ) ;_ end of vlax-for
      (vlax-for blk_def (vla-get-blocks adoc)
        (vlax-for ent blk_def
          (if (and (not (vlax-erased-p ent))
                   (member (setq ent_name (vla-get-name ent)) name_list)
              ) ;_ end of and
            (progn
              (if (vl-catch-all-error-p
                    (vl-catch-all-apply
                      (function
                        (lambda ()
                          (vla-erase ent)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    ) ;_ end of vl-catch-all-apply
                  ) ;_ end of vl-catch-all-error-p
                (setq err_list (cons ent_name err_list))
                (setq res_list (cons ent_name res_list))
              ) ;_ end of if
            ) ;_ end of progn
          ) ;_ end of if
        ) ;_ end of vlax-for
      ) ;_ end of vlax-for
      (foreach item layer_status
        (if (not (vlax-erased-p (car item)))
          (foreach prop (cdr item)
            (vl-catch-all-apply (function (lambda () (vlax-put-property (car item) (car prop) (cdr prop)))))
          ) ;_ end of foreach
        ) ;_ end of if
      ) ;_ end of foreach
      (vla-endundomark adoc)
      (if err_list
        (progn
          (princ "\nErase errors : ")
          (foreach item (vl-sort err_list (function <))
            (princ (strcat "\n\t" item))
          ) ;_ end of foreach
        ) ;_ end of progn
      ) ;_ end of if
      (if res_list
        (progn
          (princ "\nErased success : ")
          (foreach item (vl-sort res_list (function <))
            (princ (strcat "\n\t" item))
          ) ;_ end of foreach
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.10.2022, 15:24
#16
AMDen

Инженер-проектировщик
 
Регистрация: 07.07.2016
Санкт-Петербург
Сообщений: 723


Кулик Алексей aka kpblc, Спасибо, буду тестировать.
AMDen вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP. Очистка рисунка от "пустых" блоков

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Импорт палитры блоков при помощи LISP TwoZero LISP 13 31.01.2019 17:38
Lisp. Расстановка блоков на пересечении линий. wetr LISP 22 03.04.2018 10:54
LISP. Нормализация блоков текущего файла. Кулик Алексей aka kpblc Готовые программы 82 06.07.2016 20:38
загрузка DOS прог через LISP Gaa LISP 15 12.08.2005 19:19