Dwgs cleanup

Anonymous · ‎10-16-2016

Hi all,

A former staff had not fully finished this lisp to cleanup dwg. This is to fix textstyle (all fonts should be Arial), layers, dimension, leaders. It also merge layers and preform audit.

It seems to work only on certain drawings. At some drawing, it had error-bad argument type nil.

Please help me to fix this lisp.

IDP-2P02 Partition Plan.dwg - seems to fix the dwg.

X_STRCT1,dwg - Attributes in block is fixed. Text in block not fixed. ZONED AREA - Style: DISTSY should be 18-TEXT.

I don't seem to be able to attached more xref dwg.

Thanks in advance.

mcmk8

(defun c:cleanup (/ col count ent ent_data ent_lay ent_sty ent_ht len new_lay new_tstyle obj_lay ssetmtxt dscl ent_col txtht)
   (if (setq ssetmtxt (ssget "_X" '((0 . "*TEXT"))))
   (progn
      (setq len   (sslength ssetmtxt)
            count 0
      );end setq
      (while (< count len)
        (setq ent      (ssname ssetmtxt count)
              ent_data (entget ent)
              ent_sty  (cdr (assoc 7 ent_data))
              ent_lay  (cdr (assoc 8 ent_data))
              ent_ht   (cdr (assoc 40 ent_data))
              ent_col  (cdr (assoc 62 ent_data))
	      dscl     (getvar "dimscale")
              );end setq

	  (if (= (getvar "ctab") "Model")
              (setq txtht (/ ent_ht dscl))	    
	      (setq txtht ent_ht)
	  );enf if
        (cond
          ((wcmatch ent_sty "ROMANS")

                  (cond
                       ((= txtht 1.3) (setq new_tstyle "13-TEXT") (setq obj_lay ent_lay) (setq col 1))
                       ((= txtht 1.8) (setq new_tstyle "18-TEXT") (setq obj_lay ent_lay) (setq col 7))
                       ((= txtht 2.5) (setq new_tstyle "25-TEXT") (setq obj_lay ent_lay) (setq col 7))
                       ((= txtht 3.5) (setq new_tstyle "35-TEXT") (setq obj_lay ent_lay) (setq col 2))
                       ((= txtht 5.0) (setq new_tstyle "5-TEXT") (setq obj_lay ent_lay) (setq col 5))
                       ((= txtht 7.0) (setq new_tstyle "7-TEXT") (setq obj_lay ent_lay) (setq col 6))
                       (T (setq obj_lay ent_lay) (setq new_tstyle "18-TEXT") (setq col 7) (setq txtht ent_ht))
                  );end cond
                 );end wcmatch
      
          ((wcmatch ent_lay "TXT-#,TXT-##")
                 (cond
                      ((= ent_lay "TXT-13") (setq obj_lay "TEXT-13") (setq col 1))
                      ((= ent_lay "TXT-18") (setq obj_lay "TEXT-18") (setq col 7))
                      ((= ent_lay "TXT-25") (setq obj_lay "TEXT-25") (setq col 7))
                      ((= ent_lay "TXT-35") (setq obj_lay "TEXT-35") (setq col 2))
                      ((= ent_lay "TXT-5") (setq obj_lay "TEXT-5") (setq col 5))
                      ((= ent_lay "TXT-7") (setq obj_lay "TEXT-7") (setq col 6))
                      (T (setq obj_lay ent_lay) (setq txtht ent_ht) (setq col 7))
                 );end cond
          );end wcmatch

          ((wcmatch ent_sty "TXT-#,TXT-##")
             (setq new_tstyle (strcat (substr ent_sty 5) "-TEXT"))
             (setq obj_lay (strcat "TEXT-" (substr ent_sty 5)))
             (setq new_lay (cons 8 (strcat "TEXT-" (substr ent_sty 5))))
                (cond
                     ((= obj_lay "TEXT-13") (setq col 1))
                     ((= obj_lay "TEXT-18") (setq col 7))
                     ((= obj_lay "TEXT-25") (setq col 7))
                     ((= obj_lay "TEXT-35") (setq col 2))
                     ((= obj_lay "TEXT-5") (setq col 5))
                     ((= obj_lay "TEXT-7") (setq col 6))
                     (T (setq obj_lay ent_lay) (setq col 7) (setq txtht ent_ht))
                );end cond
          );end wcmatch
        );end cond

         (if (not (tblsearch "Layer" obj_lay))

         (command "-Layer" "make" obj_lay "Color" col "" "")

         );end if

         (command "-style" new_tstyle "arial" txtht "" "" "" "")

;        (setq obj_layer (entmod (subst (cons 8 obj_lay) (assoc 8 ent_data) ent_data)))

;        (setq obj_style (entmod (subst (cons 7 new_tstyle) (assoc 7 ent_data) ent_data)))

        (setq ent_data (subst (cons 8 obj_lay) (assoc 8 ent_data) ent_data))

        (setq ent_data (subst (cons 7 new_tstyle) (assoc 7 ent_data) ent_data))

        (entmod ent_data)

        (setq count (1+ count))
        );end while
      );end progn
    );end if
  (princ)
;  )

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(setq ssetdim (ssget "_X" '((0 . "DIMENSION,LEADER")))
      len (sslength ssetdim)
      count 0
);setq 

(while (< count len)
       (setq ent (ssname ssetdim count)
             ent_data (entget ent)
             ent_name (cdr (assoc 3 ent_data))
       );setq

(cond

 ((wcmatch ent_name "DIM#")(setq new_dstyle (cons 3 (substr ent_name 1 4))))

 ((wcmatch ent_name "DIM##")(setq new_dstyle (cons 3 (substr ent_name 1 5))))

 ((wcmatch ent_name "DIM###")(setq new_dstyle (cons 3 (substr ent_name 1 6))))

 ((wcmatch ent_name "DIM#$#")(setq new_dstyle (cons 3 (substr ent_name 1 4))))

 ((wcmatch ent_name "DIM##$#")(setq new_dstyle (cons 3 (substr ent_name 1 5))))

 ((wcmatch ent_name "DIM###$#")(setq new_dstyle (cons 3 (substr ent_name 1 6))))

);end cond

(setq ent_data (subst new_dstyle (assoc 3 ent_data) ent_data))

(entmod ent_data)

(setq count (1+ count))

);end while

; Returns T or nil (=fail).
(defun TextStyleChange (obj / hgt newStl stl)

  (setq hgt (vla-get-height obj))
  (setq stl (strcase (vla-get-stylename obj)))
  (if
    (and
      (setq newStl
        (cond
          ((wcmatch stl "TXT-##,TXT-#")
            (strcat (substr stl 5) "-TEXT")
          )
          ((= stl "ROMANS")
            (cond
              ((vl-position hgt '(1.3 2.6 6.5 13.0 26.0 32.5 65.0 130.0))
                "13-TEXT"
              )
              ((vl-position hgt '(1.8 3.6 9.0 18.0 36.0 45.0 90.0 180.0))
                "18-TEXT"
              )
              ((vl-position hgt '(2.5 12.5 62.5 250.0))
                "25-TEXT"
              )
              ((vl-position hgt '(3.5 7.0 17.5 35.0 70.0 87.5 175.0 350.0))
                "35-TEXT"
              )
              ((vl-position hgt '(5.0 10.0 25.0 50.0 100.0 125.0 500.0)) ; Removed: 250.0.
                "5-TEXT"
              )
              (T
                "7-TEXT"
              )
            )
          )
        )
      )
      (or
        (tblobjname "style" newStl)
        (progn
          (princ (strcat "\nError: " newStl " not found "))
          nil
        )
      )
    )
    (progn
      (vla-put-stylename obj newStl)
      T
    )
  )
)

(defun FontChange (obj) ; Obj=text style object.
  (if (wcmatch (strcase (vla-get-name obj)) "##-TEXT,#-TEXT,DIMSTYLE")
    (vla-put-fontfile obj "C:/Windows/Fonts/arial.ttf")
  )
)

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

    (command "_.-LAYER" "_A" "S" "Original" "" "" ""); add Layer State Original
;end add

;  (setq ctm (getvar "tilemode"))

;  (setvar "tilemode "0")

;  (command "vplayer" "Freeze" "*" "all" "")

;  (setvar "tilemode" ctm)

  (command "-layer" "off" "*" "N" "")

  (command "-layer" "on" "*" "")

  (command "-layer" "Freeze" "*" "")

  (command "-layer" "Thaw" "*" "")

  (command "-layer" "Lock" "*" "")

  (command "-layer" "Unlock" "*" "")

  (if (not (tblsearch "LAYER" "DIM1,DIM2,DIM5,DIM10,DIM20,DIM50,DIM100,DIM-N"))

(command "-LAYER" "M" "DIM1" "C" "7" ""
                  "M" "DIM2" "C" "7" ""
                  "M" "DIM5" "C" "7" ""
                  "M" "DIM10" "C" "7" ""
                  "M" "DIM20" "C" "7" ""
                  "M" "DIM50" "C" "7" ""
                  "M" "DIM100" "C" "7" ""
                  "M" "DIM-N" "C" "7" "" ""
); end command
); end if

  (command ".-laymrg" "n" "DIM1" "" "N" "DIM-N" "Y")
  (command ".-laymrg" "n" "DIM2" "" "N" "DIM-N" "Y")
  (command ".-laymrg" "n" "DIM5" "" "N" "DIM-N" "Y")
  (command ".-laymrg" "n" "DIM10" "" "N" "DIM-N" "Y")
  (command ".-laymrg" "n" "DIM20" "" "N" "DIM-N" "Y")
  (command ".-laymrg" "n" "DIM50" "" "N" "DIM-N" "Y")
  (command ".-laymrg" "n" "DIM100" "" "N" "DIM-N" "Y")


  (command "_.-PURGE" "_La" "DIM1,DIM2,DIM5,DIM10,DIM20,DIM50,DIM100,DIM-N" "_N")
  (princ)
  (princ "\nLayers merged...")
  (princ)
;end add  
  (if (not (tblsearch "LAYER" "TXT-12.5,TXT-13,TXT-18,TXT-25,TXT-35,TXT-5,TXT-7,TEXT-12.5,TEXT-13,TEXT-18,TEXT-25,TEXT-35,TEXT-5,TEXT-7,RESERVES,RESERVES-N,MIRROR,MIRRORS, 13-TEXT,18-TEXT,25-TEXT,35-TEXT,5-TEXT,7-TEXT,REV-CLOUD")) 
(command "-LAYER" "M" "TXT-12.5" "C" "1" "TXT-12.5" 
                  "M" "TXT-13" "C" "1" "TXT-13" 
                  "M" "TXT-18" "C" "7" "TXT-18" 
                  "M" "TXT-25" "C" "7" "TXT-25" 
                  "M" "TXT-35" "C" "2" "TXT-35" 
                  "M" "TXT-5" "C" "5" "TXT-5" 
                  "M" "TXT-7" "C" "6" "TXT-7" 
                  "M" "TEXT-12.5" "C" "1" "TEXT-12.5" 
                  "M" "TEXT-13" "C" "1" "TEXT-13" 
                  "M" "TEXT-18" "C" "7" "TEXT-18" 
                  "M" "TEXT-25" "C" "7" "TEXT-25" 
                  "M" "TEXT-35" "C" "2" "TEXT-35" 
                  "M" "TEXT-5" "C" "5" "TEXT-5"
                  "M" "TEXT-7" "C" "6" "TEXT-7"
                  "M" "RESERVES" "C" "1" "RESERVES"
                  "M" "RESERVES-N" "C" "1" "RESERVES-N"
                  "M" "MIRROR" "C" "1" "MIRROR"
                  "M" "MIRRORS" "C" "1" "MIRRORS"
                  "M" "REV-CLOUD" "C" "10" ""
                  "S" "0" ""
);command
 );if
 (command "_.-LAYER" "_A" "R" "Original" "" "" "")
 (command "-layer" "off" "*" "N" "on" "*" "Freeze" "*" "Thaw" "*" "Lock" "*" "Unlock" "*" "")
;end add
  (command ".-laymrg" "n" "TXT-12.5" "" "N" "TEXT-13" "Y")
  (command ".-laymrg" "n" "TXT-13" "" "N" "TEXT-13" "Y")
  (command ".-laymrg" "n" "TXT-18" "" "N" "TEXT-18" "Y")
  (command ".-laymrg" "n" "TXT-25" "" "N" "TEXT-25" "Y")
  (command ".-laymrg" "n" "TXT-35" "" "N" "TEXT-35" "Y")
  (command ".-laymrg" "n" "TXT-5" "" "N" "TEXT-5" "Y")
  (command ".-laymrg" "n" "TXT-7" "" "N" "TEXT-7" "Y")
  (command ".-laymrg" "n" "RESERVES" "" "N" "RESERVES-N" "Y")
  (command ".-laymrg" "n" "MIRROR" "" "N" "MIRRORS" "Y")
  (command "_.-PURGE" "_La" "TEXT-12.5,TEXT-13,TEXT-18,TEXT-25,TEXT-35,TEXT-5,TEXT-7,RESERVES-N,MIRRORS,DIM-N" "N")
  (command "_.-LAYER" "_A" "R" "Original" "" "")

  (if (not (tblsearch "style" "13-TEXT,18-TEXT,25-TEXT,35-TEXT,5-TEXT,7-TEXT"))
           (COMMAND "-STYLE" "13-TEXT" "arial" 1.3 "" "" "" ""
                    "-STYLE" "25-TEXT" "arial" 2.5 "" "" "" ""
                    "-STYLE" "35-TEXT" "arial" 3.5 "" "" "" ""
                    "-STYLE" "5-TEXT" "arial" 5.0 "" "" "" ""
                    "-STYLE" "7-TEXT" "arial" 7.0 "" "" "" ""
                    "-STYLE" "18-TEXT" "arial" 1.8 "" "" "" ""
           ); end command
  );end if

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for obj (vla-get-textstyles doc)
    (FontChange obj)
  )
  (vlax-for blk (vla-get-blocks doc)
    (if (= :vlax-false (vla-get-isxref blk))
      (vlax-for obj blk
        (if (= (vla-get-objectname obj) "AcDbAttributeDefinition")
          (TextStyleChange obj)
        )
      )
    )
  )
  (if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
    (repeat (setq i (sslength ss))
      (foreach obj (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'getattributes)
        (TextStyleChange obj)
      )
    )
  )
  (vla-regen doc acallviewports)
 (command "_audit" "Y") 
  (princ)
)

scot-65 · ‎10-18-2016

>>(if (not (tblsearch "LAYER" "TXT-12.5,TXT-13,TXT-18,TXT-25,TXT-35,TXT-5,TXT-7,TEXT-12.5,TEXT-13,TEXT-18,TEXT-25,TEXT-35,TEXT-5,TEXT-7,RESERVES,RESERVES-N,MIRROR,MIRRORS, 13-TEXT,18-TEXT,25-TEXT,35-TEXT,5-TEXT,7-TEXT,REV-CLOUD"))

A quick look, this item caught my eye:
TBLSEARCH accepts one argument at a time. The lines of code that follows the test
above will always execute!

Create a list and check using FOREACH or use TBLNEXT.
Nest a COND inside to set values.
Make a call to a function to clean up the code.

(CLEANUP_Style "13-TEXT" "arial" 1.3)

Layer "New" accepts comma separated values (enclosed in quotes) in lieu of the
one-at-a-time Make method.

???

Scot-65
A gift of extraordinary Common Sense does not require an Acronym Suffix to be added to my given name.

Anonymous · ‎10-18-2016

Hi Scot,

Thanks for your response. With my shallow lisp knowledge, can you please help me get into the lisp itself, which to be taken out and change.

For textstyle & dimstyle, we wanted all styles to use Arial font. At the moment, I think it is not fixing the text in blocks.

Your assistance is most appreciated. Thanks

scot-65 · ‎10-19-2016

It's been a while since I used TBLNEXT...

This will get you started.

(while (setq a (tblnext "STYLE" (not a)))

(if (/= (strcase (cdr (assoc 3 a))) "ARIAL.TTF")

(command "-STYLE" (cdr (assoc 2 a)) "Arial.ttf" "" "" "" "" "")

);if

);while

untested.

Investigate assoc 3 for the known font. it could be Arial.shx or Arial.TTF. If TTF, you will need to specify

the full font file name with extension (not so with SHX).

Double-check that there are enough double-quotes to end the -Style command as well...

There is a VL equivalent that others might provide.

???

Scot-65
A gift of extraordinary Common Sense does not require an Acronym Suffix to be added to my given name.

Community

Dwgs cleanup

Dwgs cleanup

Dwgs cleanup