CAD修改文字的字体程序

修改文字的字体

(defun *error*(st)

(princ (strcat "Error: " st))

(princ)

)

(defun C:chst(/ test ss len n en1 a oldr newr ent nn)

(setvar "CMDECHO" 0)

(setq test T nn 0)

(while test

(setq ss (ssadd))

(setq ss (ssget))

(if (= nil ss)

(setq test nil)

(progn

(setq len (sslength ss))

(setq n 1 s 1)

(while (<= n len)

(setq en1 (ssname ss (1- n)))

(setq a (entget en1))

(if (= "TEXT" (cdr (assoc 0 a)))

(progn

(if (= s 1)

(progn

(setq oldr (cdr (assoc 7 a)))

(setq newr (strcase (getstring (strcat "\nNew font <" oldr ">:")))) (if (= newr "") (setq newr oldr))

(setq s nil)

)

)

(if (= (tblsearch "style" newr) nil)

(progn

(cond ((= newr "XW")

(command "STYLE" "xw" "txt" "0" ".8" "0" "n" "n" "n")) ((= newr "HZ")

(command "STYLE" "hz" "txt,hztxt" "0" ".8" "0" "n" "n" "n")) ((= newr "CHINA")

(command "STYLE" "china" "txt,china" "0" ".8" "0" "n" "n" "n")) ((= newr "LM")

(command "STYLE" "lm" "complex" "0" ".8" "0" "n" "n" "n")) (T (princ (strcat "\nPlease define style " newr " use STYLE command !")))

)

)

)

(setq ent (subst (cons 7 newr) (assoc 7 a) a)) (entmod ent)

(setq nn (1+ nn))

)

)

(setq n (1+ n))

)

)

)

)

(princ (strcat (itoa nn) " changed !"))

(princ)

)