CADXChange

Todos los comandos LISP

CXPURGELimpiezaVersión 1.0.0Probado en AutoCAD

Depurar el dibujo hasta que no quede nada por quitar

Ejecuta la depuración repetidamente hasta que ya no se pueda quitar nada, porque lo que no se usa suele esconderse dentro de otros elementos sin usar. El informe indica qué se eliminó.

Descargar cxpurge.lspCondiciones LISP

Cómo se usa

  1. Escribe CXPURGE.
  2. Espera a que terminen las pasadas.
  3. Lee cuántos bloques, capas, tipos de línea y estilos se eliminaron.

Conviene saber

  • Lo que sigue en uso se conserva. U deshace la depuración.

Cargarlo en AutoCAD

  1. Guarda el archivo donde quieras.
  2. Escribe APPLOAD, elige el archivo y pulsa Cargar.
  3. Escribe el nombre del comando: CXPURGE.

Para tenerlo en cada inicio, agrégalo al Contenido de inicio en el mismo cuadro de diálogo, o carga una carpeta entera de una vez con el cargador opcional. Sobre el cargador opcional

Probado en AutoCAD (versión completa). Otros programas que ejecutan AutoLISP pueden funcionar, pero no se han probado.

El código

Texto sin más, nada oculto. Cópialo en un archivo llamado cxpurge.lsp o descárgalo.

;;; ============================================================================
;;; CXPURGE - Purge the drawing until nothing more goes
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxpurge
;;; Tested in: AutoCAD (full version). Other programs that run AutoLISP may work but are not tested.
;;; Copyright (c) CADXChange. Free for personal and commercial use; do not resell or
;;; republish it as a collection. Terms: https://cadxchange.net/legal/lisp-terms
;;; ============================================================================

;; How many entries the tables that PURGE touches hold: (blocks layers linetypes styles dimstyles).
(defun cx:purge-counts ( / out r)
  (foreach tbl '("BLOCK" "LAYER" "LTYPE" "STYLE" "DIMSTYLE")
    (setq r (tblnext tbl T) out (cons 0 out))
    (while r
      (setq out (cons (1+ (car out)) (cdr out)) r (tblnext tbl))))
  (reverse out))

;; Purge unused blocks, layers, linetypes, styles and the like until nothing more goes. Nested definitions need
;; several rounds. Returns the entries removed per table, in the order of cx:purge-counts.
(defun cx:purge-run ( / before after)
  (setq before (cx:purge-counts))
  (repeat 4
    (command "_.-PURGE" "_A" "*" "_N"))
  (setq after (cx:purge-counts))
  (mapcar '- before after))

(defun c:CXPURGE ( / *error* cx:sv r)
  (setq *error* cx:err)
  (cx:start '(("CMDECHO" . 0)))
  (setq r (cx:purge-run))
  (cx:end)
  (princ (strcat "\nRemoved: " (itoa (nth 0 r)) " blocks, " (itoa (nth 1 r)) " layers, " (itoa (nth 2 r)) " linetypes, "
                 (itoa (nth 3 r)) " text styles, " (itoa (nth 4 r)) " dimension styles."))
  (princ))


;;; ---- Shared helpers (used by the command above; identical in every CADXChange tool) ----

;; Close the undo step and put the system variables back.
(defun cx:end ()
  (foreach v cx:sv (setvar (car v) (cdr v)))
  (command "_.UNDO" "_End")
  (setq cx:sv nil)
  (princ))

;; Error handler: restores everything, stays quiet on Esc.
(defun cx:err (msg)
  (if (> (getvar "CMDACTIVE") 0) (command))
  (cx:end)
  (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg)))
  (princ))

;; Save the system variables in VARS ((name . value) ...), set them, and open one undo step.
;; The caller declares cx:sv as a local so the saved values live exactly as long as the command.
(defun cx:start (vars)
  (setq cx:sv (mapcar (function (lambda (v) (cons (car v) (getvar (car v))))) vars))
  (command "_.UNDO" "_Begin")
  (foreach v vars (setvar (car v) (cdr v)))
  (princ))

(princ "\nCXPURGE loaded. Type CXPURGE to start.")
(princ)

Historial de versiones

Versión 1.0.0 · 27 de octubre de 2026

Primera versión.

Más comandos: Limpieza