;                                          US
;                       By Brian Forbes - http://www.autolisp.org/
;                            Home of the custom built lisp!
; 
;  Permissions:
;    Permission is hereby granted to copy and modify this lisp.  It is provided "as is" by the author.
;    The authorship and url must remain with the copied functions.  
;  Version:
;    1.0 - April 19, 2004
;  Explanation:
;    Fixes undefined shape xx error message.
;  Known bugs:
;    Does not consider blocks for mtext fix.
;    If alternate font is not set, I'm not sure what happens.
;  Function call:
;    US on the command line

(defun c:us ( / altfont styles a b c mtset modme total curtxtlst count cur nestedlst) ; badlst is global (in case mtext needs to be processed again)
  (if badlst (princ "This function has already been run.\n"))
  ; -- setting styles  --
  (setq altfont (getvar "fontalt"))
  (setq styles (getstylelist))
  (foreach a styles
    (if (wcmatch a "*|*") (setq styles (vl-remove a styles) nestedlst (append (list a) nestedlst)))
  ) ; foreach 
  (foreach a styles 
    (setq b (cdr (assoc 3 (setq c (entget (tblobjname "style" a))))))
    (if (not (findfile b))
      (progn
        (setq badlst (append badlst (list (list a b)))) 
;       (entmod (subst (cons 3 altfont) (assoc 3 c) c)) ; these didn't seem to stick when dwg was saved
        (command "style" a altfont "" "" "" "" "" "")   ; using command line function
      ) ; progn
    ) ; if
  ) ; foreach styles
  (if badlst (princ "\n") (princ " All fonts were found. None replaced.\n"))
  ; -- styles set    --
  ; -- process mtext --
  (setq mtset (ssget "x" (list (cons 0 "MTEXT")))) 
  (setq count (sslength mtset))
  (while (>= (setq count (1- count)) 0)
    (setq cur (entget (ssname mtset count)) modme nil)
    (setq curtxtlst (list (cdr (assoc 1 cur))))
    (foreach a cur
      (if (= (car a) 3) (setq curtxtlst (append curtxtlst (list (cdr a)))))
    ) ; foreach cur
    (foreach a curtxtlst
      (foreach b badlst
        (if (wcmatch a (strcat "*\\f" (car b) "*")) 
          (if (member (cons 1 a) cur)
            (setq modme (setq cur (subst (cons 1 (remove-mtext-font a)) (cons 1 a) cur)))
            (setq modme (setq cur (subst (cons 3 (remove-mtext-font a)) (cons 3 a) cur)))
          ) ; if 1 else 3
        ) ; if bad font found
      ) ; foreach badlst
    ) ; foreach curtxtlst
    (if modme (progn (entmod cur) (setq total (if total (1+ total) 1))))
  ) ; while
  ; -- mtext processed --
  (foreach a badlst
    (princ "Font ") (princ (cadr a)) (princ " was updated with ") (princ altfont) (princ " in style ") (princ (car a)) (princ ".\n")
  ) ; foreach badlst
  (if total (progn (princ "Total Mtext objects changed: ") (princ total) (princ "\n")))
  (setq blks (ssget "x" (list (cons 0 "insert"))))
  (if blks (princ (strcat (itoa (sslength blks)) " blocks may contain mtext that was not considered.\n")))
  (if nestedlst (princ (strcat (itoa (length nestedlst)) " styles in external refrences remain unchecked.\n")))
  (princ "\nTo complete the process correctly, be sure all layers to be considered are thawed and all blocks to be considered are exploded.  When finished running, purge and reopen the drawing.")
  (princ)
) ; c:us

(defun remove-mtext-font (str / pos) ; by Brian Forbes - http://www.autolisp.org/
  (strcat 
    (substr str 1 (setq pos (vl-string-search "\\f" str)))
    (substr str (+ 2 (vl-string-position 59 str pos)) (strlen str)) 
  ) ; strcat
) ; remove-mtext-font

(defun getstylelist ( / stylelist nll)
  (setq stylelist (list (cdr (assoc 2 (tblnext "style" T)))))
  (while (setq nll (tblnext "style"))
    (setq stylelist (append stylelist (list (cdr (assoc 2 nll)))))
  ) ; while
  stylelist
); getstylelist