Логотип сайта поддержки пользователей САПРО сайте поддержки пользователей САПР Translate to:

Удаление всех объектов POINT 5 и V50-словарей (уменьшает разхмер чертежного файла)

Назад к списку функций
;;; purge-point.LSP
;;; Эти команды нужно использовать с осторожностью, так как они могут разрушить 
;;; связи в объектах. Но с другой стороны они могут существенно уменьшить размер
;;; чертежных файлов. Так на примере архитектурного чертежа удалось уменьшить размер с 1061 КБ до ;;; 172 КБ.
;;;
;;; c:purge-vent - уничтожает все POINT 5 vent-объекты and V50-словари
;;; c:purge-aec - уничтожает все POINT 5 архитектурные объекты и словари
;;; для корректной работы, команда purge-aec должна быть запущена при выгруженной POINT A
;;; c:purge-point5 - уничтожает все POINT 5 общие объекты в чертеже
;;; c:purge-point - уничтожает все  POINT общие объекты в чертеже
;;; c:purge-all-point - запускает все команды, описанные выше
;;; 
;;; Проверено на AutoCAD 2000 и POINT 5

(defun deldict (dictName)
  (dictremove (namedobjdict) dictName)
)

(defun listdictionaries ()
  (massoc 3 (entget (namedobjdict)))
)

(defun massoc (key alist / x nlist)
  (foreach x alist
    (if (eq key (car x))
      (setq nlist (cons (cdr x) nlist))
    )
  )
  (reverse nlist)
)

(defun kill-dict (typ / olderr oldcmdecho errexit undox restore en more ed no repl ed360 ed3)
  (defun errexit (s)
    (princ "\nError:  ")
    (princ s)
    (restore)
  )

  (defun undox ()
    (command "._undo" "_E")
    (setvar "cmdecho" oldcmdecho)
    (setq *error* olderr)
    (princ)
  )

  (setq olderr  *error*
        restore undox
        *error* errexit
  )
  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "._UNDO" "_BE")
  (initget 0 "Yes No")
  (setq repl (getkword "\nAre you sure? [Yes/No] : "))
  (if repl
    (progn
      (setq en (entnext))
      (setq more (not (not en)))
      (setq no 0)
      (while more
        (setq ed (entget en))
        (if (and
              (/= (member '(102 . "{ACAD_XDICTIONARY") ed) nil)
              (setq ed360 (assoc 360 ed))
              (setq ed3 (assoc 3 (entget (cdr ed360))))
              (wcmatch (strcase (cdr ed3)) (strcase typ))
            )
          (progn
            (entdel en)
            (setq ed
                   (append
                     (reverse
                       (cdr (member '(102 . "{ACAD_XDICTIONARY") (reverse ed)))
                     )
                     (cdr (member '(102 . "}") ed))
                   )
            )
            (if (not (entmake ed))
              (progn
                (entdel en)
                (princ "\nError deleting: ")
                (princ en)
              )
              (setq no (1+ no))
            )
          )
          (if (= (setq en (entnext en)) nil)
            (setq more nil)
          )
        )
      )
      (foreach dict (listdictionaries)
        (if (wcmatch (strcase dict) (strcase typ)) (deldict dict))
      )
    )
  )
  (princ "\nNumber of deleted objects: ")
  (princ no)
  (restore)
)

(defun c:purge-vent() (kill-dict "V50*"))
(defun c:purge-point5() (kill-dict "Point5*"))
(defun c:purge-point() (kill-dict "Point"))
(defun c:purge-aec() (kill-dict "PointAec*"))
(defun c:purge-all-point() (kill-dict "Point*") (kill-dict "V50*"))
(princ)



Copyright © Сайт поддержки пользователей САПР by Victor Tkachenko