lsp Free LISP to clean up and shrink heavy DWG files (DWGCLEAN)

[Engineer Atlas]

Hi all,

I kept running into drawings that had ballooned to tens of MB, slow to open and painful to share. So I put together a small routine, DWGCLEAN, that runs the full cleanup in one command. Sharing it here in case it saves someone else the hassle.
 

What it does, in order:

• Purges orphaned RegApp records (the hidden junk third-party and exported objects leave behind)
• Runs a full PURGE several times, to catch nested items that only become purgeable after their parent is gone
• Runs AUDIT with fix, to repair database errors
• WBLOCKs the whole drawing into a fresh file, which is the step that actually rebuilds and shrinks it
   

It writes a new file with a _clean suffix and never touches your original. It also prints the before/after size and the percent saved when it finishes.

Here is the code:
 

(vl-load-com)

;; ---- helper: bytes -> whole-KB string ------------------------------------
(defun ea:kb (bytes) (itoa (fix (/ (float bytes) 1024.0))))

(defun c:DWGCLEAN ( / *error* old-cmdecho old-filedia old-expert
                      src-dir src-name src-path base target n pass
                      size-before size-after saved pct )

  ;; ---- error handler: always restore system variables --------------------
  (defun *error* (msg)
    (if old-cmdecho (setvar "CMDECHO" old-cmdecho))
    (if old-filedia (setvar "FILEDIA" old-filedia))
    (if old-expert  (setvar "EXPERT"  old-expert))
    (if (and msg (not (member msg '("Function cancelled" "quit / exit abort"))))
      (princ (strcat "\nDWGCLEAN error: " msg)))
    (princ)
  )

  ;; ---- make sure the drawing is saved to disk ----------------------------
  (setq src-dir  (getvar "DWGPREFIX")
        src-name (getvar "DWGNAME"))
  (setq src-path (strcat src-dir src-name))

  (if (or (= src-dir "")
          (not (wcmatch (strcase src-name) "*.DWG"))
          (not (findfile src-path)))
    (progn
      (princ "\n*** Save the drawing to a folder first, then run DWGCLEAN again. ***")
      (exit))
  )

  (setq size-before (vl-file-size src-path))

  ;; ---- save current sysvars, then set a clean automation state -----------
  (setq old-cmdecho (getvar "CMDECHO")
        old-filedia (getvar "FILEDIA")
        old-expert  (getvar "EXPERT"))
  (setvar "CMDECHO" 0)
  (setvar "FILEDIA" 0)
  (setvar "EXPERT"  5)   ; suppress overwrite / confirmation prompts

  (princ "\n================ Engineer Atlas :: DWGCLEAN ================")

  ;; ---- STEP 1: remove RegApps -------------------------------------------
  (princ "\n[1/4] Removing RegApps ...")
  (command "_.-PURGE" "_Regapps" "*" "_No")

  ;; ---- STEP 2: purge all unused, several passes for nested items --------
  (princ "\n[2/4] Purging unused layers, blocks, linetypes, styles ...")
  (setq pass 0)
  (while (< pass 4)
    (command "_.-PURGE" "_All" "*" "_No")
    (setq pass (1+ pass)))

  ;; ---- STEP 3: audit and fix --------------------------------------------
  (princ "\n[3/4] Auditing and fixing database errors ...")
  (command "_.AUDIT" "_Yes")

  ;; ---- STEP 4: WBLOCK the entire drawing into a fresh file ---------------
  (setq base   (vl-filename-base src-path))
  (setq target (strcat src-dir base "_clean.dwg"))
  (setq n 1)
  (while (findfile target)                    ; never overwrite an existing file
    (setq target (strcat src-dir base "_clean_" (itoa n) ".dwg"))
    (setq n (1+ n)))
  (princ (strcat "\n[4/4] Writing clean file: " (vl-filename-base target) ".dwg ..."))
  (command "_.-WBLOCK" target "*")

  ;; ---- restore sysvars ---------------------------------------------------
  (setvar "CMDECHO" old-cmdecho)
  (setvar "FILEDIA" old-filedia)
  (setvar "EXPERT"  old-expert)

  ;; ---- report before / after --------------------------------------------
  (setq size-after (if (findfile target) (vl-file-size target) nil))
  (princ "\n-----------------------------------------------------------")
  (if (and size-before size-after (> size-before 0))
    (progn
      (setq saved (- size-before size-after))
      (setq pct   (fix (* 100.0 (/ (float saved) size-before))))
      (princ (strcat "\nOriginal : " (ea:kb size-before) " KB"))
      (princ (strcat "\nCleaned  : " (ea:kb size-after)  " KB"))
      (princ (strcat "\nSaved    : " (ea:kb saved) " KB  (" (itoa pct) "%)")))
    (princ "\nClean file written."))
  (princ (strcat "\nNew file : " target))
  (princ "\nOpen the *_clean.dwg and verify it before replacing your original.")
  (princ)
)

(princ "\nDWGCLEAN loaded.  Type  DWGCLEAN  to reduce your DWG file size.  (Engineer Atlas)")
(princ)

 

Load it with APPLOAD (or drag it into the drawing), then type DWGCLEAN. I have also attached the file if you would rather load the file directly, since forum copy-paste sometimes mangles the formatting.

 

If you would rather do it by hand without the LISP, here is the same workflow manually:

1. Type -PURGE, choose Regapps, enter * for all, No to "verify each"
2. Type -PURGE, choose All, * , No. Run this 3 or 4 times so nested blocks and styles clear out
3. Type AUDIT, answer Yes to fix any errors
4. Type WBLOCK, select the entire drawing, and save it to a new file name. Open that new file and check it

 

One safety note: always work on a copy of anything important, and open the _clean file to verify it before you replace the original. The routine is deliberately non-destructive (no OVERKILL, no xref detach, no exploding of objects), so it will not alter your geometry.

Hope it is useful. Feedback welcome if anyone spots an edge case.

DWGCLEAN.lsp

[SLW210]

I have moved your thread to the AutoLISP, Visual LISP & DCL Forum.

 

Welcome to CADTutor!

[VicoWang]

Welcome

You can try distributing plugins using the VedaCAD method, which supports LSP, FAS, VLX, ARX, and DLL format plugins. There's no need to configure paths or copy code anymore; on the user side, a 6-digit VCID = a certain plugin function, and it is directly available.