;;-------------------=={ Layer Extractor }==------------------;;
;;                                                            ;;
;;  Produces a report detailing the layer structure in every  ;;
;;  drawing in a selected directory (and subdirectories).     ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version:  1.4  28-04-2011                                 ;;
;;------------------------------------------------------------;;


(defun c:lm_LayerExtract

   ( /

    ;; --=={ Local Functions }==--

    *error*
    _directorymode
    _directorytext
    _getlayerproperties
    _padright
    _readconfig
    _replaceentrefs 
    _writeconfig
    _writedcl
    _xmloptions

    ;; --=={ Local Variables }==--

    _lxbit
    _lxcur
    _lxdir
    _lxl
    _lxpad
    _lxref
    _lxsl
    _lxsub
    acapp
    acdoc
    acdocs
    cfgfname
    ch
    data
    dc
    dclfname
    dcltitle
    df
    doc
    ext
    i
    l
    len
    ll
    ln
    lst
    odbx
    ofile
    out
    p
    padc
    savepath
    sfile
    shell
    str
    sym
    symlist
    tc
    tiles
    title
    titles
    tl
    val
    vallist
    versionnumber
    x
    xtitles

    ;; --=={ Global Variables }==--

    ;; -None-
    
   )
  
  (mai_last_com "lm_LayerExtract")
  (setq VersionNumber "1-4"
        titles '("图层" "颜色" "线型" "线宽" "打印" "打印样式" "开" "锁定" "冻结" "冻结新视口" "说明")
  ) ;; Headings

  ;;----------------------------------------------------------;;
  ;;                     Local Functions                      ;;
  ;;----------------------------------------------------------;;

  (defun *error* ( msg )
    (if dc (unload_dialog dc))
    (mapcar
      (function
        (lambda ( file ) (if (and file (eq 'FILE (type file))) (close file)))
      )
      (list ofile sfile)
    )
    (mapcar 'LM:ReleaseObject (list Shell odbx))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** 错误信息: " msg " **")))
    (princ)
  )

  ;............................................................;

  (defun _GetLayerProperties ( doc mode xref / _TF funcs l )

    (defun _tf ( v ) (if (eq v :vlax-true) "是" "否"))

    (setq funcs
     '(
        (lambda ( x ) (if  (vlax-property-available-p x 'Description) (vlax-get-property x 'Description) ""))
        (lambda ( x ) (_tf (vlax-get-property x 'ViewportDefault)))
        (lambda ( x ) (_tf (vlax-get-property x 'Freeze)))
        (lambda ( x ) (_tf (vlax-get-property x 'Lock)))
        (lambda ( x ) (_tf (vlax-get-property x 'Layeron)))
        (lambda ( x ) (vlax-get x 'PlotStyleName))
        (lambda ( x ) (_tf (vlax-get-property x 'Plottable)))
        (lambda ( x / w )
          (if (minusp (setq w (vlax-get x 'lineweight)))
            "默认值"
            (rtos (/ w 100.) 2 2)
          )
        )
        (lambda ( x ) (vlax-get x 'Linetype))
        (lambda ( x / tc )
          (if (eq acColorMethodByACI (vlax-get-property (setq tc (vlax-get-property x 'TrueColor)) 'ColorMethod))
            (itoa (vlax-get-property x 'Color))
            (vl-prin1-to-string
              (mai_lst2str (mapcar '(lambda ( p ) (itoa (vlax-get-property tc p))) '(Red Green Blue)) ",")
            )
          )
        )
        (lambda ( x ) (vlax-get x 'name))
      )
    )
    (vlax-for layer (vlax-get doc 'Layers)
      (if (or xref (not (wcmatch (vlax-get layer 'name) "*|*")))
        (setq l
          (cons
            (
              (lambda ( i / result )
                (foreach x funcs
                  (if (= (setq i (lsh i -1)) (logand i mode))
                    (setq result (cons ((eval x) layer) result))
                  )
                )
                result
              )
              2048
            )
            l
          )
        )
      )
    )
    (vl-sort l '(lambda ( a b ) (< (car a) (car b))))
  )

  ;............................................................;
  
  (defun _PadRight ( st ch ln )
    (
      (lambda ( l )
        (while (< (length l) ln) (setq l (cons ch l)))
        (vl-list->string (reverse l))
      )
      (reverse (vl-string->list st))
    )
  )

  ;............................................................;


  (defun _WriteConfig ( filename lst / ofile )
    (if (setq ofile (open filename "w")) 
      (progn
        (foreach x lst (write-line (vl-prin1-to-string x) ofile))
        (setq ofile (close ofile))
        T
      )
    )
  )

  ;............................................................;

  (defun _ReadConfig ( filename lst / ofile )
    (and (setq filename (findfile filename))
         (setq ofile (open filename "r"))
         (progn
			(foreach x lst (set x (read (read-line ofile))))
			(setq ofile (close ofile))
			T
         )
    )
  )
  
  ;............................................................;

  (defun _WriteDCL ( fname / ofile )
    (if (not (findfile fname))
      (if (setq ofile (open fname "w"))
        (progn
          (foreach str
            '(
             "//--------------------=={ 图层提取器 }==----------------------//"
             "//  此文件是图层提取器的对话框文件，图层提取器LISP程序        //"
             "//  运行时将调用此文件。                                      //"
             "//  作者: Lee Mac, Copyright ?2011 - www.lee-mac.com          //"
             "//------------------------------------------------------------//"
             ""
             "boxcol : boxed_column {  width =  65.0; fixed_width  = true; alignment = centered; }"
             "butt12 :       button {  width =  12.0; fixed_width  = true; alignment = centered; }"
             "space1 :       spacer { height =   0.1; fixed_height = true;                       }"
             "pop    : popup_list   {  width =  13.6; fixed_width = true ; alignment = centered; }"
             ""
             "layerextract : dialog { key = \"dctitle\"; spacer;"
             "  : text { label = \"Copyright (c) 2011 Lee Mac\"; alignment = right; }"
             "  : boxcol { label = \"要提取的图层要素\";"
             "    spacer;"
             "    : row { alignment = centered; spacer;"
             "      : column {"
             "        : toggle { key = \"layer\"; label = \"名称\"; value = \"1\"; is_enabled = false; }"
             "        : toggle { key = \"colour\"; label = \"颜色\"; }"
             "        : toggle { key = \"linetype\"; label = \"线型\"; }"
             "      }"
             "      : column {"
             "        : toggle { key = \"lineweight\"; label = \"线宽\"; }"
             "        : toggle { key = \"plot\"; label = \"打印\"; }"
             "        : toggle { key = \"plotstyle\"; label = \"打印样式\"; }"
             "      }"
             "      : column {"
             "        : toggle { key = \"on\"; label = \"开\"; }"
             "        : toggle { key = \"locked\"; label = \"锁定\"; }"
             "        : toggle { key = \"frozen\"; label = \"冻结\"; }"
             "      }"
             "      : column {"
             "        : toggle { key = \"frozenvp\"; label = \"冻结新视口\"; }"
             "        : toggle { key = \"description\"; label = \"说明\"; }"
             "        : spacer { height = 1.5; fixed_height = true; }"
             "      }"
             "      "
             "    }"
             "    spacer;"
             "  }"
             "  spacer;"
             "  : boxcol { label = \"图纸目录\";"
             "    : row {"
             "      : column { space1; : text { key = \"dir_text\"; alignment = left; } space1; }"
             "      : butt12 { label = \"浏览...\"; key = \"dir\"; }"
             "    }"
             "    : row {"
             "      : toggle { key = \"sub_dir\"; label = \"包括子目录\"; }"
             "      : toggle { key = \"cur_dwg\"; label = \"仅当前图纸文件\"   ; }"
             "    }"
             "    spacer;"
             "  }"
             "  spacer;"
             "  : boxcol { label = \"输出选项\";"
             "    : row {"
             "      : column { space1; : text { key = \"out_text\"; alignment = left; } space1; }"
             "      : butt12 { label = \"浏览...\"; key = \"browse\"; }"
             "    }"
             "    : row {"
             "      : column { space1; : toggle { key = \"xref\"; label = \"包括外部参照图层\"; alignment = left; } space1;}"
             "      : column { space1; : text { key = \"pad_text\"; label = \"填充字符:\"; alignment = right; } space1; }"
             "      : column { : pop { key = \"pad\"; } space1;}"
             "    }"
             "  }"
             "  spacer;"
             "  : row { spacer;"
             "    : butt12 { key = \"xml\"; label = \"可扩展标记语言\"; }"
             "    : spacer { width = 3.06; fixed_width  = true; height = 2.06; fixed_height = true; }"
             "    ok_cancel;"
             "  }"
             "}"
             "xml : dialog { label = \"语言选项\"; spacer;"
             "  : row { spacer_1;"
             "    : column {"
             "      : toggle { key = \"xl\"; label = \"Excel兼容模式\"; }"
             "      : toggle { key = \"xsl\"; label = \"创建XSL样式表\"; }"
             "    }"
             "  }"
             "  spacer; ok_cancel;"
             "}"
             )
            (write-line str ofile)
          )
          (setq ofile (close ofile))
          (while (not (findfile fname)))
          t
        )
      )
      t
    )
  )

  ;............................................................;

  (defun _DirectoryMode ( val )
    (foreach x '("sub_dir" "dir" "dir_text") (mode_tile x (atoi val)))
  )

  ;............................................................;

  (defun _DirectoryText ( key str )
    (set_tile key
      (if str
        (if (< 50 (strlen str))
          (strcat (substr str 1 47) "...") str
        )
        ""
      )
    )
  )


  ;............................................................;

  (defun _ReplaceEntRefs ( string / _stringsubst )

    (defun _stringsubst ( new old string / i nl )
      (setq i 0 nl (strlen new))
      (while (and (< i (strlen string)) (setq i (vl-string-search old string i)))
        (setq string (vl-string-subst new old string i) i (+ i nl))
      )
      string
    )
    
    (mapcar
      '(lambda ( pair ) (setq string (_stringsubst (car pair) (cdr pair) string)))
     '(
        ("&lt;"   .  "<")
        ("&gt;"   .  ">")
        ("&amp;"  .  "&")
        ("&apos;" .  "'")
        ("&quot;" . "\"")
      )
    )
    string
  )

  ;............................................................;

  (defun _XMLOptions ( handle / xl xsl )    
    (cond
      ( (new_dialog "xml" handle)
        (set_tile "xl"  (setq xl  _LXL ))
        (set_tile "xsl" (setq xsl _LXSL))
        (action_tile "xl"  "(setq xl  $value xsl (set_tile \"xsl\" \"0\"))")
        (action_tile "xsl" "(setq xsl $value xl  (set_tile \"xl\"  \"0\"))")
        (if (= 1 (start_dialog)) (setq _LXL xl _LXSL xsl))
      )
      (
        (princ "\n** 加载语言选项对话框时发生错误 **")
      )
    )
  )

  ;;----------------------------------------------------------;;
  ;;                       Main Routine                       ;;
  ;;----------------------------------------------------------;;

  (setq acapp  (vlax-get-acad-object)
        acdoc  (vlax-get acapp 'ActiveDocument)
        acdocs (vlax-for doc (vlax-get acapp 'Documents)
                 (setq acdocs (cons (cons (strcase (vlax-get doc 'FullName)) doc) acdocs))
               )
  )
  (or (vl-file-directory-p (setq SavePath (strcat mai_mini_path "用户设置")))
      (progn (princ "\n** 保存路径无效 **") (exit))
  )
  (setq dclfname (strcat SavePath "\\LMAC_LayerExtract_V" VersionNumber ".dcl")
        cfgfname (strcat SavePath "\\LMAC_LayerExtract_V" VersionNumber ".cfg")
        dcltitle (strcat "图层提取器 V" (vl-string-translate "-" "." VersionNumber))
        SymList '(_LXDir _LXCur _LXSub _LXBit _LXRef _LXPad _LXL _LXSL)
        ValList  (list (strcat mai_mini_path "用户设置") "0" "0" 2047 "0" "0" "0" "1")
  )
  (or (findfile cfgfname)
      (_WriteConfig cfgfname ValList)
  )
  (_ReadConfig cfgfname SymList)
  (mapcar '(lambda ( sym val ) (or (boundp sym) (set sym val))) SymList ValList)
  
  ;............................................................;

  (cond
    (
      (not (_WriteDCL dclfname))
      (princ "\n** 生成对话框时发生错误 **")
    )
    (
      (<= (setq dc (load_dialog dclfname)) 0)
      (princ "\n** 加载DCL对话框文件时发生错误 **")
    )
    (
      (not (new_dialog "layerextract" dc))
      (setq dc (unload_dialog dc))
      (princ "\n** 加载对话框界面时发生错误 **")
    )
    (t

      (setq tiles '("colour" "linetype" "lineweight" "plot" "plotstyle" "on" "locked" "frozen" "frozenvp" "description"))
      (set_tile "dctitle" dcltitle)
      (_DirectoryText "dir_text" _LXDir)
      (set_tile       "sub_dir"  _LXSub)
      (_DirectoryMode (set_tile "cur_dwg" _LXCur))
      (set_tile "out_text" "请选择输出文件路径")
      (set_tile "xref" _LXref)
      (mai_filldcl_list  "pad" '("空格 [ ]" "制表符 [	 ]" "点 [.]" "连字符 [-]" "逗号 [,]" "分号 [;]"))
      (set_tile "pad" _LXPad)
      (foreach x '("pad" "pad_text") (mode_tile x 1))
      (mode_tile "xml" 1)
      (
        (lambda ( i )
          (mapcar '(lambda ( x ) (set_tile x (if (= (setq i (lsh i 1)) (logand _LXBit i)) "1" "0"))) tiles)
        )
        1
      )
      (action_tile "dir"
        (vl-prin1-to-string
          (quote
            (progn
              (if (setq tmp1 (mai_Getdir "选择要处理的图纸目录..." nil))
                (_DirectoryText "dir_text" (setq _LXDir tmp1))
              )
            )
          )
        )
      )
      (action_tile "sub_dir" "(setq _LXSub $value)")
      (action_tile "cur_dwg" "(_DirectoryMode (setq _LXCur $value))")
      (action_tile "browse"
        (vl-prin1-to-string
          (quote
            (progn
              (if (setq tmp1 (getfiled "创建输出文件" "" "txt;csv;xml" 1))
                (_DirectoryText "out_text" (setq out tmp1))
                (if out
                  (_DirectoryText "out_text" out)
                  (set_tile "out_text" "请选择输出文件的路径")
                )
              )
                (cond
                  ( (not out))
                  ( (eq ".TXT" (setq ext (strcase (vl-filename-extension out))))
                    (foreach x '("pad" "pad_text") (mode_tile x 0))
                    (mode_tile "xml" 1)
                  )
                  ( (eq ".XML" ext)
                    (foreach x '("pad" "pad_text") (mode_tile x 1))
                    (mode_tile "xml" 0)
                  )
                  (t
                    (foreach x '("pad" "pad_text") (mode_tile x 1))
                    (mode_tile "xml" 1)
                  )
                )
            )
          )
        )
      )

      (action_tile "xref" "(setq _LXref $value)")
      (action_tile "pad"  "(setq _LXPad $value)")
      (action_tile "xml"  "(_XMLOptions dc)")
      (
        (lambda ( i )
          (mapcar
             '(lambda ( tile )
                (action_tile tile
                  (strcat "(setq _LXBit ((if (eq \"1\" $value) + -) _LXBit " (itoa (setq i (lsh i 1))) " ))")
                )
              )
              tiles
          )
        )
        1
      )

      (action_tile "accept"
        (vl-prin1-to-string
          (quote
            (progn
              (cond
                (
                  (not out)
                  (mai_dos_Popup "Information" 64 "Please Specify an Output File")
                )
                (
                  (not
                    (setq lst
                      (cond
                        ( (eq "1" _LXCur)
                          (list
                            (cond
                              ( (eq "" (vlax-get acdoc 'FullName))
                                (strcat (vl-string-right-trim "\\" (vlax-get-property acdoc 'Path)) "\\" (vlax-get-property acdoc 'name))
                              )
                              ( (vlax-get acdoc 'FullName) )
                            )
                          )
                        )
                        ( (mai_dos_supersubdir _LXDir "*.dwg" (eq "1" _LXSub)) )
                      )
                    )
                  )
                  (mai_dos_Popup "Information" 48 "No Drawing Files Found in the Selected Directory")
                )
                ( (done_dialog 1) )
              )
            )
          )
        )
      )
     
      (setq df (start_dialog) dc (unload_dialog dc))

  ;............................................................;

      (if (= 1 df)
        (progn
          (setq odbx (LM:ObjectDBXDocument))
          (foreach dwg lst
            (if
              (setq doc
                (cond
                  ( (eq "1" _LXCur) acdoc )
                  ( (cdr (assoc (strcase dwg) acdocs)) )
                  ( (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list odbx dwg)))) odbx )
                )
              )
              (progn
                (setq data (cons (cons dwg (_GetLayerProperties doc _LXBit (eq "1" _LXref))) data))
                (princ (strcat "\n--> 提取文件: " (vl-filename-base dwg) ".dwg"))
              )          
              (princ (strcat "\n**  打开: " (vl-filename-base dwg) ".dwg时发生错误"))
            )
          )
          (LM:ReleaseObject odbx)
          (if (setq data (vl-sort data '(lambda ( a b ) (< (car a) (car b)))) l data)
            (if (setq ofile (open out "w"))
              (progn
                (
                  (lambda ( i )
                    (setq titles
                      (vl-remove-if-not
                        '(lambda ( x )  (= (setq i (if (zerop i) 1 (lsh i 1))) (logand i _LXBit)))
                         titles
                      )
                    )
                  )
                  0
                )

                (cond
                  (
                    (eq ".TXT" (setq ext (strcase (vl-filename-extension out))))
                    (write-line
                      (strcat "图层提取时间: " (menucmd "m=$(edtime,$(getvar,DATE),DDDD DD MONTH YYYY HH:MM:SS)"))
                      ofile
                    )
                    (setq tl titles l (apply 'append (mapcar 'cdr l)) padC (nth (atoi _LXPad) '(32 9 46 45 44 59)))
                    (while (car (setq x (mapcar 'car l)))
                      (setq ll (cons (+ 5 (apply 'max (mapcar 'strlen (cons (car tl) x)))) ll) tl (cdr tl) l (mapcar 'cdr l))
                    )
                    (setq ll (reverse ll))
                    (foreach x data
                      (write-line (strcat "\n图纸文件:  " (car x)) ofile)
                      (foreach item (cons titles (cdr x))
                        (write-line
                          (vl-string-right-trim (chr padC)
                            (apply 'strcat
                              (mapcar '(lambda ( str len ) (_PadRight str padC len)) item ll)
                            )
                          )
                          ofile
                        )
                      )
                    )
                  )
                  (
                    (eq ".CSV" ext)
                    (write-line
                      (strcat "图层提取时间:,"
                        (menucmd "m=$(edtime,$(getvar,DATE),DDDD DD MONTH YYYY HH:MM:SS)")
                      )
                      ofile
                    )

                    (foreach x data
                      (write-line (strcat "\n图纸文件:," (car x)) ofile)
                      (foreach item (cons titles (cdr x))
                        (write-line (mai_lst2str item ",") ofile)
                      )
                    )
                  )
                  (
                    (eq ".XML" ext)
                    (cond
                      (
                        (eq "0" _LXL)
                        (setq xtitles (mapcar '(lambda ( title ) (vl-string-translate " " "_" (strcase title t))) titles))
                        (write-line "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>" ofile)
                        (if (eq "1" _LXSL)
                          (write-line (strcat "<?xml-stylesheet type=\"text/xsl\" href=\"" (vl-filename-base out) ".xsl\"?>") ofile)
                        )                       
                        (write-line "<extraction>" ofile)
                        (write-line
                          (strcat "\t<title>Layer Extraction: "
								(menucmd "m=$(edtime,$(getvar,DATE),DDDD DD MONTH YYYY HH:MM:SS)")
								"</title>"
                          )
                          ofile
                        )

                        (foreach x data
                          (write-line "\t<file>" ofile)
                          (write-line (strcat "\t\t<filename>" (_ReplaceEntRefs (car x)) "</filename>") ofile)
                          (foreach item (cdr x) (write-line "\t\t<layer_item>" ofile)                            
                            (mapcar
                              '(lambda ( tag value )
                                  (write-line (strcat "\t\t\t<" tag ">" (_ReplaceEntRefs value) "</" tag ">") ofile)
                               )
                               xtitles item
                            )
                            (write-line "\t\t</layer_item>" ofile)
                          )
                          (write-line "\t</file>" ofile)
                        )
                        (write-line "</extraction>" ofile)

                        (if (eq "1" _LXSL)
                          (if (setq sfile (open (strcat (vl-filename-directory out) "\\" (vl-filename-base out) ".xsl") "w"))
                            (progn
                              (mapcar
                                '(lambda ( x ) (write-line x sfile))
                                (append
                                  (list
                                    "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>"
                                    "<xsl:stylesheet version=\"1.0\" xmlns:xsl=\"http://www.w3.org/1999/XSL/Transform\">"
                                    "<xsl:template match=\"/\">"
                                    "<html>"
                                    "\t<head><title>Layer Extraction</title></head>"
                                    "\t<body style=\"font-family:Verdana,Arial;font-size:10pt;background-color:#cccccc;\">"
                                    "\t\t<h3><xsl:value-of select=\"extraction/title\"/></h3>"
                                    "\t\t<table border=\"1\" cellpadding=\"5\" style=\"border-collapse:collapse;border:1px solid navy;\">"
                                    "\t\t\t<xsl:for-each select=\"extraction/file\">"
                                    "\t\t\t\t<tr bgcolor=\"#2e2e2e\">"
                                    "\t\t\t\t<th colspan=\"11\" style=\"text-align:left;color:silver;\"><xsl:value-of select=\"filename\"/></th>"
                                    "\t\t\t\t</tr>"
                                    "\t\t\t\t<tr bgcolor=\"#a8c3f3\">"
                                  )
                                  (mapcar '(lambda ( x ) (strcat "\t\t\t\t<th>" x "</th>")) titles)
                                  (list
                                    "\t\t\t\t</tr>"
                                    "\t\t\t\t<xsl:for-each select=\"layer_item\">"
                                    "\t\t\t\t\t<tr>"                         
                                    "\t\t\t\t\t<xsl:choose>"
                                    "\t\t\t\t\t\t<xsl:when test=\"position() mod 2 = 0\">"
                                    "\t\t\t\t\t\t\t<xsl:attribute name=\"bgcolor\">#a8c3f3</xsl:attribute>"
                                    "\t\t\t\t\t\t</xsl:when>"
                                    "\t\t\t\t\t\t<xsl:otherwise>"
                                    "\t\t\t\t\t\t\t<xsl:attribute name=\"bgcolor\">#5c97ff</xsl:attribute>"
                                    "\t\t\t\t\t\t</xsl:otherwise>"
                                    "\t\t\t\t\t</xsl:choose>"
                                    (strcat "\t\t\t\t\t<td style=\"font-weight:bold;\"><xsl:value-of select=\"" (car xtitles) "\"/></td>")
                                  )
                                  (mapcar '(lambda ( x ) (strcat "\t\t\t\t\t<td><xsl:value-of select=\"" x "\"/></td>")) (cdr xtitles))
                                  (list
                                    "\t\t\t\t\t</tr>"
                                    "\t\t\t\t</xsl:for-each>"
                                    "\t\t\t</xsl:for-each>"
                                    "\t\t</table>"
                                    "\t</body>"
                                    "</html>"
                                    "</xsl:template>"
                                    "</xsl:stylesheet>"
                                  )
                                )
                              )
                              (setq sfile (close sfile))
                            )
                            ;;(princ "\n** Unable to Create XML StyleSheet (XSL) File **")
                            (princ "\n** 无法创建样式表(XSL)文件 **")
                          )
                        )
                      )
                      (
                        (eq "1" _LXL)

                        (foreach x
                         '(
                           "<?xml version=\"1.0\"?>"
                           "<?mso-application progid=\"Excel.Sheet\"?>"
                           "<Workbook"
                           "xmlns=\"urn:schemas-microsoft-com:office:spreadsheet\""
                           "xmlns:o=\"urn:schemas-microsoft-com:office:office\""
                           "xmlns:x=\"urn:schemas-microsoft-com:office:excel\""
                           "xmlns:ss=\"urn:schemas-microsoft-com:office:spreadsheet\""
                           "xmlns:html=\"http://www.w3.org/TR/REC-html40\">"
                          )
                          (write-line x ofile)
                        )

                        (foreach x data
                          (write-line (strcat "\t<Worksheet ss:Name=\"" (_ReplaceEntRefs (vl-filename-base (car x))) "\">") ofile)
                          (write-line
                            (strcat
                              "\t\t<Table ss:ExpandedColumnCount=\"" (itoa (length titles)) "\""
                              " ss:ExpandedRowCount=\"" (itoa (1+ (length (cdr x))))
                              "\" x:FullColumns=\"1\" x:FullRows=\"1\" ss:DefaultRowHeight=\"15\">"
                            )
                            ofile
                          )
                          (write-line "\t\t\t<Row>" ofile)
                          (foreach title titles
                            (write-line (strcat "\t\t\t\t<Cell><Data ss:Type=\"String\">" (_ReplaceEntRefs title) "</Data></Cell>") ofile)
                          )
                          (write-line "\t\t\t</Row>" ofile)
                          (foreach item (cdr x) (write-line "\t\t\t<Row>"  ofile)                            
                            (foreach prop item
                              (write-line
                                (strcat "\t\t\t\t<Cell><Data ss:Type=\""
                                  (if (numberp (read prop)) "Number" "String") "\">" (_ReplaceEntRefs prop) "</Data></Cell>"
                                )
                                ofile
                              )
                            )
                            (write-line "\t\t\t</Row>" ofile)
                          )                          
                          (write-line "\t\t</Table>" ofile)
                          (write-line "\t</Worksheet>" ofile)
                        )
                        (write-line "</Workbook>" ofile)
                      )
                    )
                  )
                )
                (setq ofile (close ofile))
                (princ "\n-->>> 提取完成.")
                (_WriteConfig cfgfname (mapcar 'eval SymList))
              )
              (princ "\n** 创建输出文件时发生出错 **")
            )
            (princ "\n** 没有数据写入输出文件 **")
          )
        )
        (princ "\n*取消*")
      )
    )
  )
  (princ)
)


;;-----------------=={ ObjectDBX Document }==-----------------;;
;;                                                            ;;
;;  Retrieves a version specific ObjectDBX Document object    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments: - None -                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA ObjectDBX Document object, else nil         ;;
;;------------------------------------------------------------;;

(defun LM:ObjectDBXDocument ( / acVer )
  (vla-GetInterfaceObject (vlax-get-acad-object)
    (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
      "ObjectDBX.AxDbDocument"
      (strcat "ObjectDBX.AxDbDocument." (itoa acVer))
    )
  )
)

;;------------------=={ Release Object }==--------------------;;
;;                                                            ;;
;;  Releases a VLA Object from memory via plentiful error     ;;
;;  trapping                                                  ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  obj - VLA Object to be released from memory               ;;
;;------------------------------------------------------------;;
;;  Returns:  T if Object Released, else nil                  ;;
;;------------------------------------------------------------;;

(defun LM:ReleaseObject ( obj )
  (vl-load-com)
  (and obj (eq 'VLA-OBJECT (type obj)) (not (vlax-object-released-p obj))
    (not
      (vl-catch-all-error-p
        (vl-catch-all-apply
          (function vlax-release-object) (list obj)
        )
      )
    )
  )
)


(princ)

;;------------------------------------------------------------;;
;;                         End of File                        ;;
;;------------------------------------------------------------;;