;;;Force all block definition entities whose color or linetype is neither BYLAYER or BYBLOCK ;;;to have their nonconforming color and/or linetype set to BYLAYER. ;;; ;;;Force all embedded text without thickness to have a thickness of 1. (So it can be hidden) ;;; ;;;Blocks exempt from processing are: XREFs, "ADCADD_ZZ", "DWGSTAMP", and "DWG-EDIT-LOG" ;;; ;;; Author: ;;; Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; ;;; http://www.paracadd.com ;;; All rights reserved. ;;; ;;; Copyright: 1/04/2001 ;;; Edited: 4/11/2008 (DEFUN c:blkcolt () (SETQ blklst nil) (SETQ frst_blk (TBLNEXT "block" T)) (IF (AND frst_blk (NOT (WCMATCH (CDR (ASSOC 2 frst_blk)) "`**")) (NOT (WCMATCH (CDR (ASSOC 2 frst_blk)) "ADCADD_ZZ")) (NOT (WCMATCH (CDR (ASSOC 2 frst_blk)) "DWGSTAMP")) (NOT (WCMATCH (CDR (ASSOC 2 frst_blk)) "DWG-EDIT-LOG")) ) ;_ end of and (SETQ blklst (LIST frst_blk)) ) ;_ end of if (WHILE (SETQ nxt_blk (TBLNEXT "block")) (IF (AND (NOT (WCMATCH (CDR (ASSOC 2 nxt_blk)) "`**")) (NOT (WCMATCH (CDR (ASSOC 2 nxt_blk)) "ADCADD_ZZ")) (NOT (WCMATCH (CDR (ASSOC 2 nxt_blk)) "DWGSTAMP")) (NOT (WCMATCH (CDR (ASSOC 2 nxt_blk)) "DWG-EDIT-LOG")) ) ;_ end of and (IF blklst (SETQ blklst (APPEND blklst (LIST nxt_blk))) (SETQ blklst (LIST frst_blk)) ) ;_ end of if ) ;_ end of if ) ;_ end of while (SETQ blkout (OPEN (STRCAT (GETVAR "dwgprefix") "blocklst.txt") "a")) (WRITE-LINE "This drawing's blocks have been conformed.\nBlock definition entities are now all bylayer/byblock.\nEmbedded text/attribute has thickness. " blkout ) ;_ end of WRITE-LINE (WRITE-LINE (STRCAT (GETVAR "dwgprefix") (GETVAR "dwgname")) blkout ) ;_ end of write-line (FOREACH n blklst (IF (>= (CDR (ASSOC 70 n)) 4) nil (PROGN (SETQ needs_byset nil needs_layset nil) (SETQ subent (ENTGET (CDR (ASSOC -2 n)))) (WHILE (AND subent (/= (CDR (ASSOC 0 subent)) "ENDBLK")) (IF (OR (EQ (CDR (ASSOC 0 subent)) "TEXT")(EQ (CDR (ASSOC 0 subent)) "ATTRIB")(EQ (CDR (ASSOC 0 subent)) "ATTDEF")) (PROGN (IF (WCMATCH (STRCASE (CDR (ASSOC 8 subent))) "*TXT") NIL (PROGN (SETQ needs_layset T) (IF (EQ (CDR (ASSOC 8 subent)) "0") (SETQ subent (SUBST (CONS 8 (STRCAT (cdr (assoc 2 n)) "-txt")) (ASSOC 8 subent) subent) ) ;_ end of SETQ (SETQ subent (SUBST (CONS 8 (STRCAT (CDR (ASSOC 8 subent)) "-txt")) (ASSOC 8 subent) subent) ) ;_ end of SETQ ) (ENTMOD subent) ) ) (IF (ASSOC 39 subent) (IF (> (CDR (ASSOC 39 subent)) 0) (SETQ no_change_thk T) (SETQ subent (SUBST (CONS 39 1) (ASSOC 39 subent) subent) ) ;_ end of SETQ ) ;_ end of IF (SETQ subent (APPEND subent (LIST (CONS 39 1)))) ) ;_ end of IF (IF no_change_thk (SETQ no_change_thk nil) (PROGN (ENTMOD subent) (princ (strcat "\n Changed embedded text/attribute thickness. " (cdr (assoc 2 n)))) (SETQ no_change_thk nil) ) ;_ end of progn ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (IF (AND (ASSOC 6 subent) (NOT (EQ (CDR (ASSOC 6 subent)) "BYLAYER")) (NOT (EQ (CDR (ASSOC 6 subent)) "BYBLOCK")) ) ;_ end of and (PROGN (SETQ needs_byset T) (SETQ subent (SUBST (CONS 6 "BYLAYER") (ASSOC 6 subent) subent ) ;_ end of subst ) ;_ end of setq (ENTMOD subent) ) ;_ end of PROGN ) ;_ end of if (IF (AND (ASSOC 62 subent) (NOT (EQ (CDR (ASSOC 62 subent)) 0)) (NOT (EQ (CDR (ASSOC 62 subent)) 256)) (NOT (EQ (CDR (ASSOC 62 subent)) -0)) (NOT (EQ (CDR (ASSOC 62 subent)) -256)) ) ;_ end of and (PROGN (SETQ needs_byset T) (SETQ subent (SUBST (CONS 62 256) (ASSOC 62 subent) subent) ) ;_ end of setq (ENTMOD subent) ) ;_ end of PROGN ) ;_ end of if (IF (ENTNEXT (CDR (ASSOC -1 subent))) (SETQ subent (ENTGET (ENTNEXT (CDR (ASSOC -1 subent))))) (SETQ subent nil) ) ;_ end of if ) ;_ end of while (IF (OR needs_byset needs_layset) (PROGN (WRITE-LINE (STRCAT " " (CDR (ASSOC 2 n))) blkout) (COND ((AND needs_layset needs_byset) (SETQ mod_msg "\n Color and linetype made BYLAYER, Text put on \"-txt\" layers. ")) ((AND needs_byset) (SETQ mod_msg "\n Color and linetype made BYLAYER. ")) ((AND needs_layset) (SETQ mod_msg "\n Text put on \"-txt\" layers. ")) ) (IF (ENTMOD (CDR (ASSOC -2 subent))) (princ (strcat mod_msg (cdr (assoc 2 n)))) (princ (strcat "\n ENTMOD Failed! " (cdr (assoc 2 n)))) ) ) ;_ end of progn ) ;_ end of if ) ;_ end of progn ) ;_ end of if ) ;_ end of foreach (CLOSE blkout) (PRINC) ) ;_ end of defun ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 T T nil T) ***Don't add text below the comment!***|;