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

Программа удаляет из рисунка все вхождения "пустых блоков", т.е. блоков, которые не содержат примитивов. Такие блоки не выделяются рамкой, но их можно выделить с помощью _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. Причина: Немного изменил код.
Просмотров: 6862
 
Размещение рекламы