CADXChange

Toutes les commandes LISP

CXPURGENettoyageVersion 1.0.0Testé dans AutoCAD

Purger le dessin jusqu'à ce qu'il n'y ait plus rien à retirer

Lance la purge à répétition jusqu'à ce que plus rien ne puisse être retiré, car les éléments inutilisés se cachent souvent dans d'autres éléments inutilisés. Le rapport indique ce qui a été retiré.

Télécharger cxpurge.lspConditions LISP

Comment l'utiliser

  1. Saisissez CXPURGE.
  2. Attendez la fin des passes.
  3. Lisez le nombre de blocs, calques, types de ligne et styles retirés.

Bon à savoir

  • Ce qui est encore utilisé est conservé. U annule la purge.

Le charger dans AutoCAD

  1. Enregistrez le fichier où vous voulez.
  2. Tapez APPLOAD, choisissez le fichier et cliquez sur Charger.
  3. Tapez le nom de la commande : CXPURGE.

Pour l'avoir à chaque démarrage, ajoutez-le à la Mallette de démarrage dans la même boîte de dialogue, ou chargez un dossier entier d'un coup avec le chargeur facultatif. À propos du chargeur facultatif

Testé dans AutoCAD (version complète). D'autres programmes qui exécutent AutoLISP peuvent fonctionner, mais ils n'ont pas été testés.

Le code

Du texte brut, rien de caché. Copiez-le dans un fichier nommé cxpurge.lsp ou téléchargez-le.

;;; ============================================================================
;;; 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)

Historique des versions

Version 1.0.0 · 27 octobre 2026

Première version.

Autres commandes : Nettoyage