;;;
;;;		add-me@paracadd.com
;;;
;;;	 Date:		11/1/2001
;;;
;;;Purpose:	To convert drawing contents from old font/style standard to new
;;;		font/style standard. This is accomplished by replacing the old
;;;		fonts and styles with the new standard AutoCAD fonts in new
;;;		CDM standard styles (RomanS, Arial). The old unreferenced styles
;;;		are then purged from the drawing.
;;;
;;;	Old Font	Old Style	New Style	New Font
;;;-----------------------------------------------------------------------------
;;;	CDMLROY.SHX	<any w/ font>	RomanS		RomanS.shx
;;;	CDMLROYC.SHX	ditto		RomanS		RomanS.shx
;;;	CDMLROYS.SHX	ditto		RomanS		RomanS.shx
;;;	CDMHELV.SHX	ditto		Arial		Arial.ttf
;;;
;;;	(old 15° oblique that was built into CDMLROYS is made part of existing
;;;	text/mtext entity definitions by this routine. The RomanS style has an
;;;	oblique angle of zero).
;;;
;;;	Added provision for ROMANSOB style used to create 15° oblique dimension text.
;;;	Addressed fact that style "Standard" cannot be purged.
;;;	Excluded xreference styles from being considered.
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 2-6-96
;;;>		   EDITED: 01-08-2007
;;;
(DEFUN c:stdstyle (/            romans_exst  arial_exst   dimsslen
                   dimcnt       dimentn      dimentl      nxt_blk
                   nxtentn      nxtentl      orgentl      insobjsset
                   txtobjsset   txtsslen     txtcnt       mtxobjsset
                   inssslen     inscnt       mtxsslen     mtxcnt
                   dimstyl      dimstylst    styentl      romstylst
                   aristylst    style_list   blklstlen    subent
                   updblk       romhandle    romename     arihandle
                   ariename     nstyled      cur_dimtxsty dimobjsset
                   tblstyle     oromstylst   dimstysty	  spchar_lst
                  )
  (SETQ tblstyle (TBLNEXT "style" T))
  (WHILE tblstyle
    (IF style_list
      (SETQ style_list                  ;build complete list of styles and fonts used
             (APPEND style_list
                     (LIST (LIST (CDR (ASSOC 2 tblstyle))
                                 (CDR (ASSOC 3 tblstyle))
                           ) ;_ end of list
                     ) ;_ end of list
             ) ;_ end of append
      ) ;_ end of setq
      (SETQ style_list                  ;Initiate list of styles and fonts used
             (LIST (LIST (CDR (ASSOC 2 tblstyle))
                         (CDR (ASSOC 3 tblstyle))
                   ) ;_ end of list
             ) ;_ end of list
      ) ;_ end of setq
    ) ;_ end of IF
    (IF (EQ (STRCASE (CDR (ASSOC 2 tblstyle))) "ROMANS")
      (SETQ romans_exst T)              ;check style and tell if romans exists
    ) ;_ end of if
    (IF (EQ (STRCASE (CDR (ASSOC 2 tblstyle))) "ARIAL")
      (SETQ arial_exst T)               ;check style and tell if arial exists
    ) ;_ end of if
    (SETQ tblstyle (TBLNEXT "style"))
  ) ;_ end of while
  (IF romans_exst                       ;verify/set correct RomanS style height = 0
    (IF (/= (CDR (ASSOC 40 (ENTGET (TBLOBJNAME "style" "Romans"))))
            0
        ) ;_ end of /=
      (PROGN
        (SETQ nstyled
               (SUBST
                 (CONS 40 0)
                 (ASSOC 40 (ENTGET (TBLOBJNAME "style" "Romans")))
                 (ENTGET (TBLOBJNAME "style" "Romans"))
               ) ;_ end of subst
        ) ;_ end of setq
        (ENTMOD nstyled)
      ) ;_ end of progn
    ) ;_ end of if
    (ENTMAKE (LIST (CONS 0 "style")     ;or create the RomanS style
                   (CONS 100 "AcDbSymbolTableRecord")
                   (CONS 100 "AcDbTextStyleTableRecord")
                   (CONS 2 "RomanS")
                   (CONS 70 0)
                   (CONS 40 0.0)
                   (CONS 41 1.0)
                   (CONS 50 0.0)
                   (CONS 71 0)
                   (CONS 42 2.5)        ;'last height used' might set this to 0.0875 * (a:scle)
                   (CONS 3 "romans.shx")
                   (CONS 4 "")
             ) ;_ end of list
    ) ;_ end of entmake
  ) ;_ end of if
  (IF arial_exst                        ;verify/set correct Arial style height = 0
    (IF (/= (CDR (ASSOC 40 (ENTGET (TBLOBJNAME "style" "Arial"))))
            0
        ) ;_ end of /=
      (PROGN
        (SETQ nstyled
               (SUBST
                 (CONS 40 0)
                 (ASSOC 40 (ENTGET (TBLOBJNAME "style" "Arial")))
                 (ENTGET (TBLOBJNAME "style" "Arial"))
               ) ;_ end of subst
        ) ;_ end of setq
        (ENTMOD nstyled)
      ) ;_ end of progn
    ) ;_ end of if
    (ENTMAKE (LIST (CONS 0 "style")     ;or create the Arial style
                   (CONS 100 "AcDbSymbolTableRecord")
                   (CONS 100 "AcDbTextStyleTableRecord")
                   (CONS 2 "Arial")
                   (CONS 70 0)
                   (CONS 40 0.0)
                   (CONS 41 1.0)
                   (CONS 50 0.0)
                   (CONS 71 0)
                   (CONS 42 2.5)        ;'last height used' might set this to 0.0875 * (a:scle)
                   (CONS 3 "arial.ttf")
                   (CONS 4 "")
             ) ;_ end of list
    ) ;_ end of entmake
  ) ;_ end of if
  (SETQ romhandle (ASSOC 5 (ENTGET (TBLOBJNAME "style" "RomanS")))
                                        ;store handle for RomanS style
        romename  (CDR (ASSOC -1 (ENTGET (TBLOBJNAME "style" "RomanS"))))
  )                                     ;store ename for RomanS style
  (SETQ arihandle (ASSOC 5 (ENTGET (TBLOBJNAME "style" "Arial")))
                                        ;store handle for Arial style
        ariename  (CDR (ASSOC -1 (ENTGET (TBLOBJNAME "style" "Arial"))))
  )                                     ;store ename for Arial style
  (FOREACH n style_list
    (IF (AND
          (NOT (EQ (STRCASE (CAR n)) "ROMANSOB"))
          (NOT (WCMATCH (STRCASE (CAR n)) "*|*"))
          (OR (EQ (STRCASE (CADR n)) "ROMANS") ;if font is ROMANS...
              (EQ (STRCASE (CADR n)) "ROMANS.SHX")
              (EQ (STRCASE (CADR n)) "CDMLROY");or if font is CDMLROY...
              (EQ (STRCASE (CADR n)) "CDMLROY.SHX")
              (EQ (STRCASE (CADR n)) "CDMLROYC")
                                          ;or if font is CDMLROYC...
              (EQ (STRCASE (CADR n)) "CDMLROYC.SHX")
              (EQ (STRCASE (CADR n)) "CDMLROYS")
                                          ;or if font is CDMLROYS...
              (EQ (STRCASE (CADR n)) "CDMLROYS.SHX")
          )
        ) ;_ end of or
      (IF romstylst                     ;add to list of styles to change to RomanS
        (SETQ romstylst (APPEND romstylst (LIST (STRCASE (CAR n)))))
        (SETQ romstylst (LIST (STRCASE (CAR n))))
      ) ;_ end of if
    ) ;_ end of if
    (IF (OR (EQ (STRCASE (CADR n)) "ARIAL") ;if font is ARIAL...
            (EQ (STRCASE (CADR n)) "ARIAL.TTF")
            (EQ (STRCASE (CADR n)) "CDMHELV") ;if font is CDMHELV...
            (EQ (STRCASE (CADR n)) "CDMHELV.SHX")
        ) ;_ end of or
      (IF aristylst                     ;add to list of styles to change to Arial
        (SETQ aristylst (APPEND aristylst (LIST (STRCASE (CAR n)))))
        (SETQ aristylst (LIST (STRCASE (CAR n))))
      ) ;_ end of if
    ) ;_ end of if
    (IF (OR (EQ (STRCASE (CADR n)) "CDMLROYS") ;if font is CDMLROYS...
            (EQ (STRCASE (CADR n)) "CDMLROYS.SHX")
        ) ;_ end of or
      (IF oromstylst                    ;add to list of styles to change to RomanS and make oblique
        (SETQ oromstylst (APPEND oromstylst (LIST (STRCASE (CAR n)))))
        (SETQ oromstylst (LIST (STRCASE (CAR n))))
      ) ;_ end of if
    ) ;_ end of if
    (IF (OR
            (EQ (STRCASE (CADR n)) "CDMLROY") ;if font is CDMLROY...
            (EQ (STRCASE (CADR n)) "CDMLROY.SHX")
            (EQ (STRCASE (CADR n)) "CDMLROYC")
                                        ;or if font is CDMLROYC...
            (EQ (STRCASE (CADR n)) "CDMLROYC.SHX")
            (EQ (STRCASE (CADR n)) "CDMLROYS")
                                        ;or if font is CDMLROYS...
            (EQ (STRCASE (CADR n)) "CDMLROYS.SHX")
        ) ;_ end of or
      (PROGN
        (SETQ nstyled
               (SUBST
                 (CONS 3 "Romans.shx")
                 (ASSOC 3 (ENTGET (TBLOBJNAME "style" (CAR n))))
                 (ENTGET (TBLOBJNAME "style" (CAR n)))
               ) ;_ end of subst
        ) ;_ end of setq
        (SETQ nstyled (SUBST (CONS 40 0) (ASSOC 40 nstyled) nstyled))
        (ENTMOD nstyled)                ;change CDMLROY font to RomanS
      ) ;_ end of progn
    ) ;_ end of if
    (IF (OR
            (EQ (STRCASE (CADR n)) "CDMHELV") ;if font is CDMHELV...
            (EQ (STRCASE (CADR n)) "CDMHELV.SHX")
        ) ;_ end of or
      (PROGN
        (SETQ nstyled
               (SUBST
                 (CONS 3 "Arial.ttf")
                 (ASSOC 3 (ENTGET (TBLOBJNAME "style" (CAR n))))
                 (ENTGET (TBLOBJNAME "style" (CAR n)))
               ) ;_ end of subst
        ) ;_ end of setq
        (SETQ nstyled (SUBST (CONS 40 0) (ASSOC 40 nstyled) nstyled))
        (ENTMOD nstyled)                ;change CDMLHELV font to Arial
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of foreach
  (COND
    ((AND (OR
            (MEMBER (STRCASE (GETVAR "TEXTSTYLE")) romstylst)
            (MEMBER (STRCASE (GETVAR "TEXTSTYLE")) oromstylst)
          ) ;_ end of OR
          (/= (STRCASE (GETVAR "TEXTSTYLE")) "ROMANS")
     ) ;_ end of AND
     (SETVAR "TEXTSTYLE" "RomanS")
    )
    ((AND (MEMBER (STRCASE (GETVAR "TEXTSTYLE")) aristylst)
          (/= (STRCASE (GETVAR "TEXTSTYLE")) "ARIAL")
     ) ;_ end of AND
     (SETVAR "TEXTSTYLE" "Arial")
    )
  ) ;_ end of COND
  (SETQ txtobjsset
         (SSGET "x"
                '((-4 . "<OR")
                  (0 . "attdef")
                  (0 . "text")
                  (-4 . "OR>")
                 )
         ) ;_ end of ssget
  ) ;_ end of setq
  (IF txtobjsset                        ;process TEXT and ATTDEFs
    (PROGN
      (SETQ txtsslen (SSLENGTH txtobjsset)
            txtcnt   0
      ) ;_ end of setq
      (WHILE
        (< txtcnt txtsslen)
         (COND                          ;tell what's happening
           ((OR (EQ (REM (1+ txtcnt) 10) 0) (EQ txtcnt (1- txtsslen)))
            (PRINC
              (STRCAT
                "\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010"
                "Of "                   ;and increment processing no.
                (ITOA txtsslen)
                " TEXT and ATTDEF entities, processing no. "
                (ITOA (1+ txtcnt))
                "\r"
              ) ;_ end of STRCAT
            ) ;_ end of PRINC
           )
         ) ;_ end of COND
         (SETQ txtentn (SSNAME txtobjsset txtcnt))
         (SETQ txtentl (ENTGET txtentn))
         (updstyle txtentl)             ;update text entity style
         (SETQ txtcnt (1+ txtcnt))
      ) ;_ end of WHILE
      (PRINC "\n")
    ) ;_ end of PROGN
  ) ;_ end of IF
  (SETQ insobjsset (SSGET "x" '((0 . "insert"))))
  (IF insobjsset                        ;process inserts for ATTRIB occurances
    (PROGN
      (SETQ inssslen (SSLENGTH insobjsset)
            inscnt   0
      ) ;_ end of setq
      (WHILE
        (< inscnt inssslen)
         (COND                          ;tell what's happening
           (T
            (PRINC
              (STRCAT
                "\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010"
                "Of "                   ;and increment processing no.
                (ITOA inssslen)
                " INSERT entities, processing no. "
                (ITOA (1+ inscnt))
                "\r"
              ) ;_ end of STRCAT
            ) ;_ end of PRINC
           )
         ) ;_ end of COND
         (SETQ insentn (SSNAME insobjsset inscnt))
         (SETQ insentl (ENTGET insentn))
         (IF (EQ (CDR (ASSOC 66 insentl)) 1) ;if attributes follow
           (WHILE (/= (CDR (ASSOC 0 insentl)) "SEQEND")
             (updstyle insentl)         ;update insert entity style
             (SETQ insentl (ENTGET (ENTNEXT (CDAR insentl))))
           ) ;_ end of WHILE
         ) ;_ end of IF
         (SETQ inscnt (1+ inscnt))
      ) ;_ end of WHILE
      (PRINC "\n")
    ) ;_ end of PROGN
  ) ;_ end of IF
  (SETQ mtxobjsset (SSGET "x" '((0 . "mtext"))))
  (IF mtxobjsset                        ;process MTEXT
    (PROGN
      (SETQ mtxsslen (SSLENGTH mtxobjsset)
            mtxcnt   0
      ) ;_ end of setq
      (WHILE
        (< mtxcnt mtxsslen)
         (COND                          ;tell what's happening
           ((OR (EQ (REM (1+ mtxcnt) 10) 0) (EQ mtxcnt (1- mtxsslen)))
            (PRINC
              (STRCAT
                "\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010"
                "Of "                   ;and increment processing no.
                (ITOA mtxsslen)
                " MTEXT entities, processing no. "
                (ITOA (1+ mtxcnt))
                "\r"
              ) ;_ end of STRCAT
            ) ;_ end of PRINC
           )
         ) ;_ end of COND
         (SETQ mtxentn (SSNAME mtxobjsset mtxcnt))
         (SETQ mtxentl (ENTGET mtxentn)
               orgentl mtxentl
         ) ;_ end of SETQ
         (procmtxstr mtxentl)
         (SETQ mtxcnt (1+ mtxcnt))
      ) ;_ end of WHILE
      (PRINC "\n")
    ) ;_ end of PROGN
  ) ;_ end of IF
  (SETQ cur_dimtxsty (GETVAR "DIMTXSTY"))
                                        ;get current dimension text style
  (COND
    ((OR
       (MEMBER (STRCASE cur_dimtxsty) romstylst)
       (MEMBER (STRCASE cur_dimtxsty) oromstylst)
     ) ;_ end of OR
     (SETVAR "DIMTXSTY" "RomanS")       ;Set dimension text style to RomanS if current dimension text style is RomanS based
    )
    ((MEMBER (STRCASE cur_dimtxsty) aristylst)
     (SETVAR "DIMTXSTY" "Arial")        ;Set dimension text style to Arial if current dimension text style is Arial based
    )
  ) ;_ end of COND
  (SETQ dimobjsset (SSGET "x" '((0 . "DIMENSION"))))
  (IF dimobjsset                        ;process DIMENSIONs
    (PROGN
      (SETQ dimsslen (SSLENGTH dimobjsset)
            dimcnt   0
      ) ;_ end of setq
      (WHILE
        (< dimcnt dimsslen)
         (COND                          ;tell what's happening
           ((OR (EQ (REM (1+ dimcnt) 10) 0) (EQ dimcnt (1- dimsslen)))
            (PRINC
              (STRCAT
                "\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010"
                "Of "                   ;and increment processing no.
                (ITOA dimsslen)
                " DIMENSION entities, processing no. "
                (ITOA (1+ dimcnt))
                "\r"
              ) ;_ end of STRCAT
            ) ;_ end of PRINC
           )
         ) ;_ end of COND
         (SETQ dimentn (SSNAME dimobjsset dimcnt))
         (SETQ dimentl (ENTGET dimentn '("ACAD"))
                                        ;get dimension entity data w/ xdata
               nxt_blk (CDR (ASSOC 2 dimentl))
               nxtentn (CDR (LAST (TBLSEARCH "block" nxt_blk)))
               nxtentl (ENTGET nxtentn)
         ) ;_ end of SETQ
         (WHILE
           (AND nxtentn (/= (CDR (ASSOC 0 (ENTGET nxtentn))) "MTEXT"))
            (SETQ nxtentn (ENTNEXT nxtentn))
                                        ;find dimension mtext entity
         ) ;_ end of WHILE
         (SETQ mtxentl (ENTGET nxtentn)
               orgentl mtxentl
         ) ;_ end of SETQ
         (updstyle mtxentl)             ;update mtext entity style
         (COND
           ((AND (ASSOC 1005 (CDADR (ASSOC -3 dimentl)))
                                        ;if dimension overrides include text style...
                 (EQ (STRCASE (CDR (ASSOC 7 mtxentl))) "ROMANS")
            )                           ;and current/updated style is ROMANS...
            (SETQ xd_list
                   (CONS
                     -3
                     (LIST
                       (APPEND
                         (LIST "ACAD")
                         (REVERSE
                           (CDR (MEMBER (ASSOC 1005 (CDADR (ASSOC -3 dimentl)))
                                        (REVERSE (CDADR (ASSOC -3 dimentl)))
                                ) ;_ end of member
                           ) ;_ end of cdr
                         ) ;_ end of reverse
                         (LIST (CONS 1005 (CDR romhandle)))
                         (CDR (MEMBER (ASSOC 1005 (CDADR (ASSOC -3 dimentl)))
                                      (CDADR (ASSOC -3 dimentl))
                              ) ;_ end of member
                         ) ;_ end of cdr
                       ) ;_ end of append
                     ) ;_ end of list
                   ) ;_ end of cons
            ) ;_ end of setq
            (SETQ dimentl (SUBST xd_list (ASSOC -3 dimentl) dimentl))
            (ENTMOD dimentl)            ;change handle in xdata to point to ROMANS style
           )
           ((AND (ASSOC 1005 (CDADR (ASSOC -3 dimentl)))
                                        ;if dimension overrides include text style...
                 (EQ (STRCASE (CDR (ASSOC 7 mtxentl))) "ARIAL")
            )                           ;and current/updated style is ARIAL...
            (SETQ xd_list
                   (CONS
                     -3
                     (LIST
                       (APPEND
                         (LIST "ACAD")
                         (REVERSE
                           (CDR
                             (MEMBER (ASSOC 1005 (CDADR (ASSOC -3 dimentl)))
                                     (REVERSE (CDADR (ASSOC -3 dimentl)))
                             ) ;_ end of member
                           ) ;_ end of cdr
                         ) ;_ end of reverse
                         (LIST (CONS 1005 (CDR arihandle)))
                         (CDR
                           (MEMBER (ASSOC 1005 (CDADR (ASSOC -3 dimentl)))
                                   (CDADR (ASSOC -3 dimentl))
                           ) ;_ end of member
                         ) ;_ end of cdr
                       ) ;_ end of append
                     ) ;_ end of list
                   ) ;_ end of cons
            ) ;_ end of setq
            (SETQ dimentl (SUBST xd_list (ASSOC -3 dimentl) dimentl))
            (ENTMOD dimentl)            ;change handle in xdata to point to ARIAL style
           )
         ) ;_ end of cond
         (FOREACH n mtxentl
           (IF
             (OR (EQ (CAR n) 3) (EQ (CAR n) 1))
              (PROGN
                (IF (WCMATCH (STRCASE (CDR n)) "*\\F*")
                  (updstrfont n)        ;update embedded fonts in dimension MTEXT strings
                ) ;_ end of IF
                (spec_char (CDR n))
              ) ;_ end of progn
           ) ;_ end of IF
         ) ;_ end of FOREACH
         (IF (EQ orgentl mtxentl)
           nil
           (ENTMOD mtxentl)             ;apply all updates to dimension MTEXT entity
         ) ;_ end of IF
         (SETQ dimcnt (1+ dimcnt))
      ) ;_ end of WHILE
    ) ;_ end of PROGN
  ) ;_ end of IF
  (SETQ dimstyl   (TBLNEXT "dimstyle" T) ;Process dimension styles
        dimstylst nil
  ) ;_ end of setq
  (WHILE dimstyl
    (IF dimstylst                       ;build dimension style list
      (SETQ dimstylst (APPEND dimstylst (LIST (CDR (ASSOC 2 dimstyl)))))
      (SETQ dimstylst (LIST (CDR (ASSOC 2 dimstyl))))
    ) ;_ end of if
    (SETQ dimstyl (TBLNEXT "dimstyle"))
  ) ;_ end of while
  (FOREACH n dimstylst
    (SETQ styentl (ENTGET (TBLOBJNAME "dimstyle" n)))
    (COND
      ((MEMBER
         (STRCASE (CDR (ASSOC 2 (ENTGET (CDR (ASSOC 340 styentl))))))
         romstylst
       )                                ;if dimension text style is RomanS based...
       (SETQ dimstysty (CDR (ASSOC 2 (ENTGET (CDR (ASSOC 340 styentl)))))
             styentl
                       (SUBST (CONS 340 romename) (ASSOC 340 styentl) styentl)
       ) ;_ end of setq
       (ENTMOD styentl)
       (IF (EQ (STRCASE dimstysty) "ROMANS")
         nil
         (PRINC
           (STRCAT
             "\n                                        "
             "\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010"
             "  Replacing text style \"" dimstysty "\" with \"RomanS\""
             " in dimension style \"" n "\""
           ) ;_ end of STRCAT
         ) ;_ end of PRINC
       ) ;_ end of IF
      )                                 ;set dimension text style to RomanS
      ((MEMBER
         (STRCASE (CDR (ASSOC 2 (ENTGET (CDR (ASSOC 340 styentl))))))
         aristylst
       )                                ;if dimension text style is Arial based...
       (SETQ styentl
              (SUBST (CONS 340 ariename) (ASSOC 340 styentl) styentl)
       ) ;_ end of setq
       (ENTMOD styentl)
       (IF (EQ (STRCASE dimstysty) "ARIAL")
         nil
         (PRINC
           (STRCAT
             "\n                                        "
             "\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010"
             "Replacing text style \"" dimstysty "\" with \"Arial\""
             " in dimension style \"" n "\""
           ) ;_ end of STRCAT
         ) ;_ end of PRINC
       ) ;_ end of IF
      )                                 ;set dimension text style to Arial
    ) ;_ end of cond
  ) ;_ end of foreach
  (SETQ blklst nil)                     ;process BLOCK definitions
  (SETQ nxt_blk (TBLNEXT "block" T))
  (WHILE nxt_blk                        ;build block table list
    (IF (AND
          (NOT (WCMATCH (CDR (ASSOC 2 nxt_blk)) "*|*"))
          (NOT (WCMATCH (CDR (ASSOC 2 nxt_blk)) "`**"))
          (NOT (WCMATCH (CDR (ASSOC 2 nxt_blk)) "ADCADD_ZZ"))
          (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 nxt_blk))
      ) ;_ end of if
    ) ;_ end of if
    (SETQ nxt_blk (TBLNEXT "block"))
  ) ;_ end of while
  (SETQ blklstlen (LENGTH blklst)
        blkcnt    1
  ) ;_ end of setq
  (PRINC "\n")
  (IF (> blklstlen 0)
    (PROGN
      (FOREACH n blklst
        (COND                           ;tell what's happening
          ((OR (EQ (REM (1+ blkcnt) 10) 0) (EQ blkcnt (1- blklstlen)))
           (PRINC
             (STRCAT
               "                                        "
               "\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010\010"
               "Of "                    ;and increment processing no.
               (ITOA blklstlen)
               " BLOCKS , processing no. "
               (ITOA (1+ blkcnt))
               "\r"
             ) ;_ end of STRCAT
           ) ;_ end of PRINC
          )
        ) ;_ end of COND
        (IF (>= (CDR (ASSOC 70 n)) 4)   ;process only if it is not xref dependent
          nil
          (PROGN
            (SETQ updblk 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")
                    (EQ (CDR (ASSOC 0 subent)) "MTEXT")
                  ) ;_ end of OR
                (PROGN
                  (IF (ASSOC 7 subent)
                    (PROGN
                      (updstyle subent) ;update subentity style
                      (SETQ updblk T)
                    ) ;_ end of progn
                  ) ;_ end of IF
                  (IF (EQ (CDR (ASSOC 0 subent)) "MTEXT")
                    (procmtxstr subent)
                  ) ;_ end of IF
                ) ;_ end of PROGN
;;;                (IF (EQ (CDR (ASSOC 0 subent)) "INSERT")
;;;                  (PROGN
;;;                    (PRINC (STRCAT "    Nested block <" (CDR (ASSOC 2 subent)) "> found!\n"))
;;;                    (IF (EQ (CDR (ASSOC 66 subent)) 1)
;;;                      (PRINC (STRCAT "        Nested block <" (CDR (ASSOC 2 subent)) "> contains ATTRIB!\n"))
;;;                    )
;;;                  )
;;;                )
              ) ;_ 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 updblk
              (ENTMOD (CDR (ASSOC -2 subent)))
                                        ;apply all updates to block definition
            ) ;_ end of IF
          ) ;_ end of progn
        ) ;_ end of if
        (SETQ blkcnt (1+ blkcnt))
      ) ;_ end of foreach
    ) ;_ end of PROGN
  ) ;_ end of IF
  (FOREACH n romstylst
    (IF
      (OR
        (EQ n "ROMANS")
        (EQ n "STANDARD")
        (EQ n "ROMANSOB")
        (WCMATCH n "*|*")
      ) ;_ end of OR
       nil                              ;tell what we've already done in (updstyle...)
       (PROGN
         (PRINC
           (STRCAT "\nReplacing text style \"" n "\" with \"RomanS\".")
         ) ;_ end of PRINC
         (IF (MEMBER n oromstylst)
           (PRINC
             (STRCAT
               "\n  Setting oblique angle to 15 degrees for affected text and mtext."
             ) ;_ end of STRCAT
           ) ;_ end of PRINC
         ) ;_ end of IF
       ) ;_ end of PROGN
    ) ;_ end of IF
  ) ;_ end of FOREACH
  (FOREACH n aristylst
    (IF
      (OR
        (EQ n "ARIAL")
        (WCMATCH n "*|*")
      ) ;_ end of OR
       nil                              ;tell what we've already done in (updstyle...)
       (PRINC
         (STRCAT "\nReplacing text style \"" n "\" with \"Arial\".")
       ) ;_ end of PRINC
    ) ;_ end of IF
  ) ;_ end of FOREACH
  (PRINC "\n")
  (SETQ oldcmdecho (GETVAR "CMDECHO"))
  (SETVAR "CMDECHO" 0)
  (COMMAND ".-PURGE" "ST" "*" "N")      ;purge unreferenced styles
  (SETVAR "CMDECHO" oldcmdecho)
  (IF spchar_lst
    (PROGN
      (SETQ spchar_lst (acad_strlsort spchar_lst))
      (PRINC "\nThe following special characters were found and remain:\n")
      (FOREACH n spchar_lst
        (IF (EQ n (LAST spchar_lst))
          (PRINC (STRCAT "%%" n))
          (PRINC (STRCAT "%%" n ", "))
        )
      )
    )
  )
  (PRINC)
) ;_ end of defun
(DEFUN updstyle (entlist / modentl)
  (IF
    (ASSOC 7 entlist)                   ;if a style name is specified
     (COND
       ((MEMBER (STRCASE (CDR (ASSOC 7 entlist))) romstylst)
                                        ;and if it uses RomanS,
        (SETQ
          modentl (SUBST (CONS 7 "RomanS") (ASSOC 7 entlist) entlist)
        ) ;_ end of SETQ
        (spec_char (CDR (ASSOC 1 modentl)))
        (ENTMOD modentl)                ;change it to RomanS
       )
       ((MEMBER (STRCASE (CDR (ASSOC 7 entlist))) aristylst)
                                        ;or if it uses Arial,
        (SETQ
          modentl (SUBST (CONS 7 "Arial") (ASSOC 7 entlist) entlist)
        ) ;_ end of SETQ
        (spec_char (CDR (ASSOC 1 modentl)))
        (ENTMOD modentl)                ;change it to Arial
       )
     ) ;_ end of COND
  ) ;_ end of IF
  (PRINC)
) ;_ end of defun
(DEFUN updstrfont (nstr       /          assocno    txtstr
                   tmpstr     prev_strcnt           strcnt
                   endcnt     strno      fontlst    updtxstr
                  )
  (SETQ assocno     (CAR nstr)
        txtstr      (CDR nstr)
        tmpstr      txtstr
        prev_strcnt 1
        strcnt      1
        strno       1
  ) ;_ end of setq
  (WHILE (AND tmpstr                    ;while a part of the string is left
              (WCMATCH (STRCASE tmpstr) "*\\F*")
                                        ;and it has an embedded font
              (WCMATCH (STRCASE tmpstr) "*;*")
         ) ;_ end of and
    (WHILE (NOT (WCMATCH (SUBSTR (STRCASE txtstr) strcnt) "\\F*"))
                                        ;advance position counter to start of font specification
      (SETQ strcnt (1+ strcnt))
    ) ;_ end of while
    (SETQ endcnt strcnt)
    (WHILE (NOT (WCMATCH (SUBSTR (STRCASE txtstr) endcnt) ";*"))
                                        ;advance position counter to end of font specification
      (SETQ endcnt (1+ endcnt))
    ) ;_ end of while
    (IF fontlst                         ;build the list of fonts used in the string
      (SETQ
        fontlst
         (APPEND
           fontlst
           (LIST
             (LIST
               (SUBSTR txtstr (+ strcnt 2) (- endcnt strcnt 2))
               (+ strcnt 2)
               (- endcnt strcnt 2)
               (SUBSTR txtstr prev_strcnt (- strcnt prev_strcnt))
             ) ;_ end of list
           ) ;_ end of list
         ) ;_ end of append
      ) ;_ end of setq
      (SETQ fontlst
             (LIST
               (LIST (SUBSTR tmpstr (+ strcnt 2) (- endcnt strcnt 2))
                     (+ strcnt 2)
                     (- endcnt strcnt 2)
                     (SUBSTR txtstr prev_strcnt (- strcnt prev_strcnt))
               ) ;_ end of list
             ) ;_ end of list
      ) ;_ end of setq
    ) ;_ end of if
    (SETQ tmpstr      (SUBSTR txtstr endcnt)
          strcnt      (1+ endcnt)
          prev_strcnt strcnt            ;store start position of text portion of string
    ) ;_ end of setq
  ) ;_ end of while
  (SETQ updtxtstr "")
  (IF (OR fontlst oblmtx)
    (PROGN
      (IF fontlst
        (PROGN
          (FOREACH n fontlst            ;construct updated string...
            (COND
              ((OR
                 (WCMATCH (STRCASE (CAR n)) "CDMLROY.SHX")
                 (WCMATCH (STRCASE (CAR n)) "CDMLROYC.SHX")
               ) ;_ end of OR
                                        ;if CDMLROY/C).SHX is embedded
               (SETQ
                 updtxtstr
                  (STRCAT updtxtstr (NTH 3 n) "\\Fromans.shx;")
               ) ;_ end of setq
              )
              ((WCMATCH (STRCASE (CAR n)) "CDMLROYS.SHX")
                                        ;if CDMLROYS.SHX is embedded
               (SETQ
                 updtxtstr
                  (STRCAT updtxtstr (NTH 3 n) "\\Fromans.shx;\\Q15;")
                                        ;preserve oblique of CDMLROYS in embedded font.
               ) ;_ end of setq
              )
              ((WCMATCH (STRCASE (CAR n)) "CDMHELV.SHX")
                                        ;if CDMHELV.SHX is embedded
               (SETQ updtxtstr (STRCAT updtxtstr
                                       (NTH 3 n)
                                       "\\Farial|b0|i0|c2|p2;"
                               ) ;_ end of strcat
               ) ;_ end of setq
              )
              (T
               (SETQ updtxtstr
                      (STRCAT updtxtstr (NTH 3 n) "\\F" (NTH 0 n) ";")
               ) ;_ end of setq
              )
            ) ;_ end of Cond
          ) ;_ end of foreach
          (SETQ updtxtstr (STRCAT
                            updtxtstr
                            (SUBSTR txtstr
                                    (+ (NTH 1 (LAST fontlst))
                                       (NTH 2 (LAST fontlst))
                                       1
                                    ) ;_ end of +
                            ) ;_ end of substr
                          ) ;_ end of strcat
          ) ;_ end of setq
        ) ;_ end of PROGN
      ) ;_ end of IF
      (IF oblmtx
        (SETQ updtxtstr (STRCAT "\\Q15;";preserve oblique from CDMLROYS in base style (now RomanS) of Mtext.
                                (IF fontlst
                                  updtxtstr
                                  tmpstr
                                ) ;_ end of IF
                                ""
                        ) ;_ end of STRCAT
        ) ;_ end of SETQ
      ) ;_ end of IF
      (SETQ mtxentl (SUBST (CONS assocno updtxtstr)
                           (CONS assocno txtstr)
                           mtxentl
                    ) ;_ end of subst
      )                                 ;construct MTEXT entity list (entmod in calling function)
    ) ;_ end of progn
  ) ;_ end of if
  (PRINC)
) ;_ end of defun
(DEFUN procmtxstr (mtxentl /)
  (IF
    (OR
      (MEMBER (STRCASE (CDR (ASSOC 7 mtxentl))) romstylst)
                                        ;if its previous style was CDMLROY/C
      (MEMBER (STRCASE (CDR (ASSOC 7 mtxentl))) oromstylst)
    )                                   ;if its previous style was CDMLROYS
     (PROGN
       (SETQ
         mtxentl (SUBST (CONS 7 "RomanS")
                        (ASSOC 7 mtxentl)
                        mtxentl
                 ) ;_ end of SUBST
       ) ;_ end of SETQ
       (ENTMOD mtxentl)                 ;change its style to RomanS
       (IF (MEMBER (STRCASE (CDR (ASSOC 7 mtxentl))) oromstylst)
         (SETQ oblmtx T)		;remember it needs 15 degree oblique
       )
     ) ;_ end of PROGN
  ) ;_ end of IF
  (FOREACH n mtxentl
    (IF
      (OR (EQ (CAR n) 3) (EQ (CAR n) 1))
       (PROGN
         (IF (OR (WCMATCH (STRCASE (CDR n)) "*\\F*") oblmtx)
           (updstrfont n)               ;update embedded fonts in MTEXT strings
         ) ;_ end of IF
         (spec_char (CDR n)) ; was (CADR n)
       ) ;_ end of progn
    ) ;_ end of IF
  ) ;_ end of FOREACH
  (IF (EQ orgentl mtxentl)
    nil
    (ENTMOD mtxentl)                    ;apply all updates to mtext entity
  ) ;_ end of IF
  (SETQ oblmtx nil)
  (PRINC)
) ;_ end of DEFUN
(DEFUN spec_char (str / )
  (SETQ tmpspecstr str)
  (WHILE (AND (WCMATCH str "*%%###*") tmpspecstr)
    (IF (WCMATCH  tmpspecstr "%%###*")
      (PROGN
        (IF spchar_lst
          (IF (MEMBER (SUBSTR tmpspecstr 3 3) spchar_lst)
            NIL
            (SETQ spchar_lst (APPEND spchar_lst (LIST (SUBSTR tmpspecstr 3 3))))
          )
          (SETQ spchar_lst (LIST (SUBSTR tmpspecstr 3 3)))
        )
        (IF (>(STRLEN tmpspecstr)6)
          (SETQ tmpspecstr (SUBSTR tmpspecstr 6))
          (SETQ tmpspecstr NIL)
        )
      )
      (IF (>(STRLEN tmpspecstr)6)
          (SETQ tmpspecstr (SUBSTR tmpspecstr 2))
          (SETQ tmpspecstr NIL)
      )
    )
  )
)
(princ)
;|«Visual LISP© Format Options»
(72 2 40 2 T "end of " 60 9 2 1 0 nil T nil T)
;*** DO NOT add text below the comment! ***|;