Author Topic: [Community Project] Clean Drawing Program  (Read 9676 times)

0 Members and 1 Guest are viewing this topic.

Lee Mac

  • Seagull
  • Posts: 12288
  • London, England
[Community Project] Clean Drawing Program
« on: December 09, 2012, 11:00:01 AM »
Inspired by this recent thread, I thought it would be beneficial to the community for us to construct a general program to clean drawings which are bloated by hundreds or thousands of what may be deemed as unnecessary objects, or common causes of drawings with ostensibly inexplicably huge file sizes.

To begin, I have put together the following program:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:cleandwg ( / *error* _effectivename bkc cmd doc ext flg lck lst lyc )
  2.  
  3.     ;; Error Handler
  4.     (defun *error* ( m )
  5.         ;; Relock Layers
  6.         (foreach lay lck
  7.             (if (not (vlax-erased-p lay))
  8.                 (vla-put-lock lay :vlax-true)
  9.             )
  10.         )
  11.         ;; Reset CMDECHO
  12.         (if (= 'int (type cmd))
  13.             (setvar 'cmdecho cmd)
  14.         )
  15.         ;; Print critical errors
  16.         (if (not (wcmatch (strcase m t) "*break,*cancel*,*exit*"))
  17.             (princ (strcat "\nError: " m))
  18.         )
  19.         (princ)
  20.     )
  21.  
  22.     ;; Function to return block effective name
  23.     (defun _effectivename ( obj )
  24.         (if (vlax-property-available-p obj 'effectivename)
  25.             (vla-get-effectivename obj)
  26.             (vla-get-name obj)
  27.         )
  28.     )
  29.  
  30.           lyc (vla-get-layers doc)
  31.           bkc (vla-get-blocks doc)
  32.           cmd (getvar 'cmdecho)
  33.     )
  34.     ;; Unlock all layers
  35.     (vlax-for lay lyc
  36.         (if (= :vlax-true (vla-get-lock lay))
  37.             (progn
  38.                 (setq lck (cons lay lck))
  39.                 (vla-put-lock lay :vlax-false)
  40.             )
  41.         )
  42.     )
  43.  
  44.     ;; Remove Anonymous Groups
  45.     (vlax-for grp (vla-get-groups doc)
  46.         (if (wcmatch (vla-get-name grp) "`**")
  47.             (vl-catch-all-apply 'vla-delete (list grp))
  48.         )
  49.     )
  50.  
  51.     ;; Detect empty block definitions
  52.     (vlax-for blk bkc
  53.         (if
  54.             (and
  55.                 (= :vlax-false (vla-get-isxref blk))
  56.                 (= :vlax-false (vla-get-islayout blk))
  57.             )
  58.             (progn
  59.                 (vlax-for obj blk (setq flg t))
  60.                 (if (null flg)
  61.                     (setq lst (cons (strcase (vla-get-name blk)) lst))
  62.                 )
  63.                 (setq flg nil)
  64.             )
  65.         )
  66.     )
  67.     ;; Remove all references of empty definitions
  68.     (vlax-for blk bkc
  69.         (vlax-for obj blk
  70.             (if
  71.                 (and
  72.                     (= "AcDbBlockReference" (vla-get-objectname obj))
  73.                     (member (strcase (_effectivename obj)) lst)
  74.                 )
  75.                 (vl-catch-all-apply 'vla-delete (list obj))
  76.             )
  77.         )
  78.     )
  79.     ;; Remove empty block definitions
  80.     (foreach blk lst
  81.         (vl-catch-all-apply 'vla-delete (list (vla-item bkc blk)))
  82.     )
  83.  
  84.     ;; Remove Layer Property & Group Filters
  85.     (if
  86.         (and
  87.             (= :vlax-true (vla-get-hasextensiondictionary lyc))
  88.             (setq ext (vla-getextensiondictionary lyc))
  89.         )
  90.         (foreach dic '("ACLYDICTIONARY" "ACAD_LAYERFILTERS")
  91.              (vl-catch-all-apply 'vla-remove (list ext dic))
  92.         )
  93.     )  
  94.  
  95.     ;; Turn off command echo
  96.     (setvar 'cmdecho 0)
  97.    
  98.     ;; Remove unused scales
  99.     (command "_.-scalelistedit" "_D" "*" "_E")
  100.  
  101.     ;; Purge All
  102.     (repeat 3 (command "_.-purge" "_A" "*" "_N"))
  103.  
  104.     ;; Reset command echo
  105.     (setvar 'cmdecho cmd)
  106.  
  107.     ;; Relock Layers
  108.     (foreach lay lck
  109.         (if (not (vlax-erased-p lay))
  110.             (vla-put-lock lay :vlax-true)
  111.         )
  112.     )
  113.  
  114.     ;; Exit cleanly
  115.     (princ)
  116. )

As indicated by the thread title, I welcome others to contribute & improve this program, so that we may create a robust and all-purpose drawing cleaner for the community to use.

Ideas & suggestions are welcome!


Latest Version attached:
« Last Edit: December 10, 2012, 09:31:00 AM by Lee Mac »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10369
Re: [Community Project] Clean Drawing Program
« Reply #1 on: December 09, 2012, 11:05:39 AM »
Good idea Lee.
Off to play tennis but will take a look this afternoon.  :-)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lee Mac

  • Seagull
  • Posts: 12288
  • London, England
Re: [Community Project] Clean Drawing Program
« Reply #2 on: December 09, 2012, 11:07:51 AM »
Good idea Lee.
Off to play tennis but will take a look this afternoon.  :-)

Thanks Alan - have a great game!  8-)

Tharwat

  • Swamp Rat
  • Posts: 518
  • Hypersensitive
Re: [Community Project] Clean Drawing Program
« Reply #3 on: December 09, 2012, 12:13:20 PM »
It looks very useful tool and clear to read .

Is not it good idea to use vla-purgeall function instead of the command call ?

Thanks for your great efforts .  :-)

Lee Mac

  • Seagull
  • Posts: 12288
  • London, England
Re: [Community Project] Clean Drawing Program
« Reply #4 on: December 09, 2012, 01:09:20 PM »
It looks very useful tool and clear to read .

Thanks for your great efforts .  :-)

Thank you Tharwat  :-)

Is not it good idea to use vla-purgeall function instead of the command call ?

Although the PurgeAll method may be generally faster than the command call, it will not purge Multileader Styles, Empty Text objects, Zero-Length geometry, etc. etc.

roy_043

  • Water Moccasin
  • Posts: 1733
  • BricsCAD 18
Re: [Community Project] Clean Drawing Program
« Reply #5 on: December 09, 2012, 05:38:36 PM »
Some quick thoughts:

Your line 60 etc:
Code - Auto/Visual Lisp: [Select]
  1. (vlax-for obj blk (setq flg t))
Could become
Code - Auto/Visual Lisp: [Select]
  1. (if (zerop (vla-get-count blk)) ...

Why (only) remove anon groups? They can be as useful/useless as named groups.

Redundant groups:
Code - Auto/Visual Lisp: [Select]
  1. ;;; Purpose:       Get groups containing 1 or zero objects.
  2. ;;; Arguments:     groupObjectList - list of group objects
  3. ;;; Return value:  List of group objects or nil.
  4. (defun _GetRedundantGroups (groupObjectList)
  5.   (vl-remove-if
  6.     '(lambda (a) (> (vla-get-count a) 1))
  7.     groupObjectList
  8.   )
  9. )

Some portions of the program would have to be run repeatedly. Block defs can become empty if block refs of empty blocks have been deleted. Modularize?

Perhaps (also) start with purging. That way the program will potentially have to analyse/do less.

kruuger

  • Swamp Rat
  • Posts: 616
Re: [Community Project] Clean Drawing Program
« Reply #6 on: December 09, 2012, 05:46:51 PM »
really great idea Lee. my suggestions are:
- create dcl (on the fly) to select what to delete/clean and what not
- maybe multilanguage option like
Code: [Select]
(nth *l (list "Utwórz blok anonimowy\n" "Make annonymous block\n"))- maybe option to delete some dictionary (only for experts)

kruuger

BricscadBoy

  • Mosquito
  • Posts: 15
Re: [Community Project] Clean Drawing Program
« Reply #7 on: December 09, 2012, 07:10:19 PM »
You might like to consider issues coming from older Legacy drawings, or other cad apps that generate .dwg. An example of this is empty text strings. These used to be created in AutoCAD by editing some TEXT/MTEXT and deleting all the text in the dialogue, which resulted in an empty text string. This was fixed in later versions of AutoCAD, but is still possible in BricsCAD, and your likely to strike if your working on older drawings. Created the following routine to deal with.

Code - Auto/Visual Lisp: [Select]
  1. ; ****************************NOTXT.LSP*********************************
  2.  
  3. ;  Deletes empty TEXT strings from your drawing
  4. ;  Rev A
  5. ;  12/06/93
  6. ;  Jason Bourhill
  7. ; **********************************************************************
  8.  
  9. ;  Rev B
  10. ;  Updated to check for empty MTEXT strings as well.
  11. ;  10/09/99
  12. ;  Jason Bourhill
  13. ; **********************************************************************
  14.  
  15. ;  Rev C
  16. ;  Change string checking part to use wcmatch. quicker?
  17. ;  30/11/99
  18. ;  Jason Bourhill
  19. ; **********************************************************************
  20.  
  21. (defun C:NOTXT ( / searchtxt sset ans nfix)
  22.  
  23. ;-------------------------------SEARCHTXT-------------------------------
  24. (defun searchtxt (sset rstr / num txtfnd entnum ent strcomp stn)
  25. (setq num 0 txtfnd 0)
  26.  (princ "\nWorking ")
  27.  (repeat (sslength sset)
  28.         (setq entnum (ssname sset num))
  29.          (setq ent (entget entnum))
  30.          (setq stn (strlen (cdr (assoc 1 ent))))
  31.           (if (= 0 stn)(setq strcomp "")(setq strcomp " "))
  32. ;          (if (/= 0 stn) (repeat stn (setq strcomp (strcat strcomp " "))))
  33. ;           (cond ((= strcomp (cdr (assoc 1 ent)))
  34.             (cond ((wcmatch (cdr (assoc 1 ent)) strcomp)
  35.                         (if rstr (progn
  36.                                         (setq ent
  37.                                                 (subst (cons 1 rstr)
  38.                                                        (assoc 1 ent)
  39.                                                         ent
  40.                                                 )
  41.                                         )
  42.                                         (entmod ent)
  43.                                         (entupd entnum)
  44.                                         (setq txtfnd (1+ txtfnd))
  45.                                  )
  46.                                  (progn (entdel entnum) (setq txtfnd (1+ txtfnd)))
  47.                         )))
  48.         (princ ">")
  49.         (setq num (1+ num))
  50.  )
  51. txtfnd
  52. )
  53.  
  54. ;-------------------------------MAIN PROG-------------------------------
  55.  
  56. (princ "\nSearching For Text Please Wait")
  57. (setq sset
  58.  (ssget "x" (list(cons -4 "<or")
  59.                     (cons 0 "TEXT")
  60.                     (cons 0 "MTEXT")
  61.                  (cons -4 "or>")
  62.             )
  63.   )
  64.  )
  65.  (if sset (progn
  66.                 (initget "Delete Replace")
  67.                 (setq ans (getkword "\nDo you want to Delete or Replace empty text strings <Delete/Replace>: "))
  68.                 (cond ((= ans "Delete")(setq rstr nil))
  69.                       ((= ans "Replace")(setq rstr (getstring T "\nEnter replacement string: ")))
  70.                 )
  71.                 (setq nfix (searchtxt sset rstr))
  72.                 (princ (strcat "\nFound and Fixed " (itoa nfix) " Empty text strings"))
  73.          )
  74.          (princ "\nNo TEXT found in Drawing Data Base")
  75.  )
  76. )
  77.  

I've also seen bad implementation of valid objects on drawings. such as drawing a property boundary using the letter "X" instead of using an appropriate linetype. Maybe your routine needs to Audit first, provide the user with a list of potential issues, and allow them to select which ones they wish to act on.

I haven't checked, but you used to have issues with purging empty layers if you had set viewport related properties from within a paperspace viewport.


Lee Mac

  • Seagull
  • Posts: 12288
  • London, England
Re: [Community Project] Clean Drawing Program
« Reply #8 on: December 10, 2012, 08:34:36 AM »
Your line 60 etc:
Code - Auto/Visual Lisp: [Select]
  1. (vlax-for obj blk (setq flg t))
Could become
Code - Auto/Visual Lisp: [Select]
  1. (if (zerop (vla-get-count blk)) ...

Good catch roy - noted.

Why (only) remove anon groups? They can be as useful/useless as named groups.

My logic was that anonymous groups are more likely to be automatically generated by another program, or inadvertently generated by an unsuspecting user; whereas, named groups are more likely to have been created purposefully.

Redundant groups...

Good idea!

Some portions of the program would have to be run repeatedly. Block defs can become empty if block refs of empty blocks have been deleted. Modularize?

Another great idea, I had overlooked the case of nested empty block definitions whose reference is the only object within the parent definition - an unlikely scenario, but certainly should be included for completeness.

Perhaps (also) start with purging. That way the program will potentially have to analyse/do less.

Good shout - I'll change this also.

really great idea Lee.

Thanks Kruuger!  :-)

- create dcl (on the fly) to select what to delete/clean and what not

Nice idea Kruuger, I shall certainly look to implement this  :-)

- maybe multilanguage option like
Code: [Select]
(nth *l (list "Utwórz blok anonimowy\n" "Make annonymous block\n"))

Since this will be a general program for all to use, multilanguage support will be a necessity - though, I'll certainly need your's (& Google's) help with this!

- maybe option to delete some dictionary (only for experts)

The program currently removes the Layer Filter dictionaries, however, I was unsure as to which other dictionaries are unnecessary and can be safely removed in general - perhaps the AEC* dictionaries when opening a drawing in standard AutoCAD?

You might like to consider issues coming from older Legacy drawings, or other cad apps that generate .dwg. An example of this is empty text strings. These used to be created in AutoCAD by editing some TEXT/MTEXT and deleting all the text in the dialogue, which resulted in an empty text string. This was fixed in later versions of AutoCAD, but is still possible in BricsCAD, and your likely to strike if your working on older drawings.

Newer versions of AutoCAD include the option to purge Empty Text Objects using the in-built Purge command, though, I agree that it would be useful to create a separate function to remove these objects to account for versions in which the option is not present - thanks!

I've also seen bad implementation of valid objects on drawings. such as drawing a property boundary using the letter "X" instead of using an appropriate linetype.

These types of bad drafting practices will most probably be difficult to detect, and furthermore, many users may hold differing opinions over what is considered a good or bad drafting practice; for this program, I was aiming more to remove general redundancies which may be applicable across all industries of drafting.

Maybe your routine needs to Audit first, provide the user with a list of potential issues, and allow them to select which ones they wish to act on.

A great idea, but I see this being potentially difficult to implement, since some operations performed by the program (such as the Purge All operation) provide no programmatic output as to the objects available to be purged by the program.

I haven't checked, but you used to have issues with purging empty layers if you had set viewport related properties from within a paperspace viewport.

Aah, viewport overrides! Another can of worms!  :lol:

hermanm

  • Bull Frog
  • Posts: 282
Re: [Community Project] Clean Drawing Program
« Reply #9 on: December 10, 2012, 09:05:00 AM »
Quote
My logic was that anonymous groups are more likely to be automatically generated by another program, or inadvertently generated by an unsuspecting user;

I have written programs which generate "anonymous" groups, by design.
I use also a third party application which has a use for one entity groups, because it associates additional information with them.

Suggest (as others have) that you provide options as to what gets "cleaned up."
If you don't know where you are going, you might not get there.
  - L.P. Berra

Lee Mac

  • Seagull
  • Posts: 12288
  • London, England
Re: [Community Project] Clean Drawing Program
« Reply #10 on: December 10, 2012, 09:12:25 AM »
Quote
My logic was that anonymous groups are more likely to be automatically generated by another program, or inadvertently generated by an unsuspecting user;

I have written programs which generate "anonymous" groups, by design.
I use also a third party application which has a use for one entity groups, because it associates additional information with them.

Suggest (as others have) that you provide options as to what gets "cleaned up."

Agreed  :-)

Lee Mac

  • Seagull
  • Posts: 12288
  • London, England
Re: [Community Project] Clean Drawing Program
« Reply #11 on: December 10, 2012, 09:29:57 AM »
I have attached an updated version of the program to the first post of the thread, incorporating a number of comments:
  • Program has been 'modularised' into separate functions, with documentation for each function.
  • Program now accounts for nested empty block definitions.
  • 'Purge All' operation now moved to start of program.
  • Groups with fewer than 2 objects now removed.
Still to do:
  • Write program description for code header
  • Create dialog to allow user to choose items to be 'cleaned'
  • Create function to remove empty Text & MText objects
  • Multilanguage support for dialog
« Last Edit: December 10, 2012, 09:37:33 AM by Lee Mac »

Patrick_35

  • Bull Frog
  • Posts: 276
  • Rennes, France
Re: [Community Project] Clean Drawing Program
« Reply #12 on: December 10, 2012, 11:05:47 AM »
Hi

If you want, I did kind of program.
You can pick ideas here
It remains only to translate it into English

@+
The shape even of the pyramids of Egypt shows that already the workmen tended to make some less and less.
Will Cuppy, 1884-1949.

Lee Mac

  • Seagull
  • Posts: 12288
  • London, England
Re: [Community Project] Clean Drawing Program
« Reply #13 on: December 10, 2012, 11:13:11 AM »
If you want, I did kind of program.
You can pick ideas here
It remains only to translate it into English

Wow - that is a very thorough and comprehensive program Patrick - thank you for sharing your efforts  :-)

Patrick_35

  • Bull Frog
  • Posts: 276
  • Rennes, France
Re: [Community Project] Clean Drawing Program
« Reply #14 on: December 10, 2012, 11:27:56 AM »
Yes, and all the others are too detailed (on the same blog)
The only problem is that I have not mastered enough English to do the translation.
And as I have online, I was wondering what software did you animate your pictures to better explain your lisps

@+
The shape even of the pyramids of Egypt shows that already the workmen tended to make some less and less.
Will Cuppy, 1884-1949.