Fixing Textstyle, Dim Style & Layers

Anonymous — Mon, 27 Mar 2017 06:26:17 GMT
Hello,
I need some help to fixed this lisp that was written by a guy who had left the office. Basically this is to fix:
Textstyle - no more name TXT-? and move TXT-? to TEXT-? No more Romans and move to TXT-? acoording to height.
Layers - similarly merge layer TXT-? to TEXT-? and DIM? to DIM-N.
Dim Style - merge dim style according to text height to DIM1,DIM2,DIM5,...
Only Arial fonts to be used in all textstyle, dimstyle and leaders. Any Romans any where to be replaced by Arial.
Every single drawing uses xref. My limited lisp knowledge not able to fix this lisp.
Attached three dwg. X_FIXT2 is xref to IDP-2P02. Dwg is not fixed up.
Attached X_STRCT1.dwg will get error:bad argument type:stringp
Any help is most appreciated. Thanks in advance.
mcmk
(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)
)
topic Fixing Textstyle, Dim Style & Layers in Visual LISP, AutoLISP and General Customization Forum

Fixing Textstyle, Dim Style & Layers
