Search the Community
Showing results for tags 'lsp file'.
-
lsp Free LISP to clean up and shrink heavy DWG files (DWGCLEAN)
Engineer Atlas posted a topic in AutoLISP, Visual LISP & DCL
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: Type -PURGE, choose Regapps, enter * for all, No to "verify each" Type -PURGE, choose All, * , No. Run this 3 or 4 times so nested blocks and styles clear out Type AUDIT, answer Yes to fix any errors 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 -
Hello. I am using an old acad.lsp file with custom modified commands. After years of using it without any problems, it suddenly stopped working. This happened on two different computers with different versions of autocad (17 and 18) and without any software or windows updates. AutoCAD prompted me to change "command" to "command-s" in the lisp file and it resumed working. The problem now is that whenever i open a .dwg file it keeps asking me if i want to save the file on c: drive. I would like this to stop. Does anybody know if this is a lisp file issue and how to solve it?
-
Hi! I have this code that i found here in the forum it was created by @rlx. My question is how to add an automatic current date and time to the end of the file when im saving it. Many thanks! xoxo (defun c:foo (/ _dir F NF P SF SH) (defun _dir (msg path / sh folder out) (or (vl-file-directory-p path) (setq path (getvar 'dwgprefix))) (cond ((and (setq sh (vlax-get-or-create-object "Shell.Application")) (setq folder (vlax-invoke-method sh 'browseforfolder 0 msg "&H2000" path)) ) (setq out (vlax-get-property (vlax-get-property folder 'self) 'path)) (setq out (strcat (vl-string-right-trim "\\" out) "\\")) ) ) (and sh (vlax-release-object sh)) out ) (if (setq p (_dir "Pick a directory yo!" "E:\\Autocad Files\\SSC\\North Region\\SNE\\")) (progn (setq f (getvar 'dwgname)) (setq sf "Plans") (setq nf (strcat p sf "\\" f)) (cond ((cond ((findfile nf) (print "File exists...") nil) ((vl-file-directory-p (strcat p sf)) (vl-file-copy (strcat (getvar 'dwgprefix) f) nf) t) ((vl-mkdir (strcat p sf)) (vl-file-copy (strcat (getvar 'dwgprefix) f) nf) t) ) (setq sh (vlax-get-or-create-object "Shell.Application")) (vlax-invoke-method sh 'open nf) (vlax-release-object sh) ) ) ) ) (princ) ) (vl-load-com)
-
Hi, I'm having a hard time figuring out how to make a toolbar that can be downloaded for all to use. My problem is how do you share a "common directory" with the world? The toolbar works perfectly fine on my computer, because I have defined my own directory in the macro under the cui command. So the question is: how do you make a "common directory" so that the toolbar can be accessed on any computer? I hope I have made myself clear. Thanks!
- 13 replies
-
- custom toolbar
- cui
- (and 9 more)
