;;
;; Copyright (c)2012 Gu_xl
;; 版权所有  Gu_xl
;; 
;;作者保留本程序的一切权利，但你可以自由拷贝与复制、修改本程序用于非商业目的。
;;作者尽力将本程序做得完善，但不会因本软件的错失而造成的损失承担任何责任。
;;本程序仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊用途之适
;;应性, 以及商业销售所隐含作出的保证, 在此一概予以否认。 
;; 

;;;常量定义
(setq *acad*       (vlax-get-acad-object)
      *acdocument* (vlax-get *acad* 'activedocument)
      *model-space* (vlax-get *acdocument* 'modelspace)
      *paper-space* (vlax-get *acdocument* 'paperspace)
      *space* (vlax-get *acdocument* (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
)

;;;*************函数 gxl-strisnum.lsp  *************

;;;==================================================================
;;; (gxl-strIsNum str)    确定字符串是否为数字
;;;------------------------------------------------------------------
;;; 参数:
;;;        Str            str 检查的字符串
;;;------------------------------------------------------------------
;;;    Returns:
;;;        [LOG]    T ：字符串为数字, F 字符串不是数字
;;;        Example:     (setq a "+.123a") (atof "a")(atoi "-.12")
;;;                    (setq b '1B5')
;;;                (gxl-strIsNum a) 返回 T
;;;                    (gxl-strIsNum b) 返回 F
;;;==================================================================
(defun gxl-strIsNum (str / tt ll )
  (numberp
     (vl-catch-all-apply 'read
       (list (cond ((= "." (substr str 1 1)) (strcat "0" str))
                   ((and (= "-." (setq tt (substr str 1 2)))
                         (setq ll (> (strlen str) 2))
                    )
                    (strcat "-0" (substr str 2))
                   )
                   ((and ll (= "+." tt))
                    (strcat "+0" (substr str 2))
                   )
                   (str)
             )
         )
       )
  )
)
;;;***************** 函数 gxl-strIsNum*****************


;;;*************函数 gxl-strisint.lsp  *************

;;(gxl-StrIsInt str)    确定字符串是否为整数 (gxl-StrIsInt "-1.2")
(defun gxl-StrIsInt (str)
  (and (gxl-strIsNum str)
       (not (or (= "." (substr str 1 1))
                (= "-." (substr str 1 2))
                (= "+." (substr str 1 2))
            )
       )
       (= 'int (type (read str)))
  )
)
;;;***************** 函数 gxl-StrIsInt*****************


;;;*************函数 gxl-strisreal.lsp  *************
;;(gxl-StrIsReal str)    确定字符串是否为实数
(defun gxl-StrIsReal (str)
  (and (gxl-strIsNum str)
       (or (= "." (substr str 1 1))
           (= "-." (substr str 1 2))
           (= "+." (substr str 1 2))
           (= 'int (type (read str)))
           (= 'REAL (type (read str)))
       )
       
  )
)
;;;***************** 函数 gxl-StrIsReal*****************


;;;*************函数 gxl-chkreal.lsp  *************
;;;==================================================================
;;;gxl-chkreal 对话框输入检查是否为实型数函数,返回实型数或nil
;;;==================================================================

(defun gxl-chkreal (a *key*)
  (cond ((gxl-strisint a) (atoi a))
        ((gxl-strisreal a) (atof a))
        (t (alert "请输入实型数!")
           (mode_tile *key* 2)
           nil
        )
  )
)
;;;***************** 函数 gxl-chkreal*****************


;;;*************函数 gxl-chkrealp.lsp  *************
;;(gxl-chkrealp val key bits) 对话框输入检查是否为实型数函数,返回实型数或nil,bits 按位标志，1 = 非正数 2 = 非零 4 = 非负
(defun gxl-chkrealp (val key bits / chkFlag)
  (setq chkflag (gxl-chkreal val key))
  (and chkflag
       (= 1 (logand bits 1)) ;_ 1 = 非正数
       (> (atof val) 0)
      (progn
            (setq chkflag nil)
            (alert "请输入非正数!")
            (mode_tile key 2)
      )
  )
  (and chkflag
       (= 2 (logand bits 2)) ;_ 2 = 非零
       (zerop (atof val))
       (progn
           (setq chkflag nil)
           (alert "请输入非零数!")
           (mode_tile key 2)
       )
  )
  (and chkflag
       (= 4 (logand bits 4)) ;_ 4 = 非负数
       (minusp (atof val))
       (progn
            (setq chkflag nil)
            (alert "请输入非负数!")
            (mode_tile key 2)
        )
  )
  (if chkflag (if (gxl-strisint val) (atoi val) (atof val)))
)
;;;***************** 函数 gxl-chkrealp*****************


;;;*************函数 vlxls-app-open.lsp  *************
 
;|
Examples:
(setq *xlapp* (vlxls-app-new T)) è #<VLA-OBJECT _Application 001db27c>
Excel Application Session Progress Function
 
Name
 (vlxls-app-open XLSfilename ShowExcelFlag)
 
Usage
 Open a new Excel session to start existing XLS file.
 
Input
 STR
 XLS file name with full path, ".XLS" not needed.
 
BOOLEAN
 T for display, nil for hide
 
RetVal
 True
 VLOBJ
 Excel Session vla-object
 
Fail
 BOOLEAN
 NIL
 ;|;

(defun vlxls-app-open ( xlsfile unhide / excelapp worksheet sheets activesheet rtn)
  (setq xlsfile (strcase xlsfile))
  (or (wcmatch xlsfile "*`.XLS,*`.XLSX")
      (setq xlsfile (strcat xlsfile ".XLS"))
  )
  (and (findfile xlsfile)
       (setq rtn (vlax-get-or-create-object "excel.application"))
       (progn
            (vlax-put-property rtn 'visible (if unhide 1 0))
            (vlax-invoke-method (vlax-get-property rtn 'workbooks) 'open xlsfile)
       )
  )
  Rtn
)
;;;***************** 函数 vlxls-app-open*****************


;;;*************函数 vlxls-variant-》list.lsp  *************


;|
参数 Key：
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell  插入分页符
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$3"  工作表顶端标题行
        .PrintTitleColumns = ""    工作表左端标题列
    End With
    ActiveSheet.PageSetup.PrintArea = "$C$1:$H$255"   工作表打印区域
    With ActiveSheet.PageSetup
        .LeftHeader = ""    左页眉
        .CenterHeader = ""  中页眉
        .RightHeader = ""   右页眉
        .LeftFooter = "&P"  左页脚
        .CenterFooter = "&N" 中页脚
        .RightFooter = "aaaaaaaaa"  右页脚
        .LeftMargin = Application.InchesToPoints(0.62)   左边距
        .RightMargin = Application.InchesToPoints(0.748031496062992) 右边距
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)   
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic  打印起始页
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
    End With
End Sub

Copyright(C) 1994-2005 by KozMos Inc.

Permission to use, copy, modify, and distribute this software for any purpose and without fee is hereby
granted, provided that the above copyright notice appears in all copies and that both that copyright notice
and the limited warranty and restricted rights notice below appear in all supporting documentation.
KozMos PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS. KozMos SPECIFICALLY DISCLAIMS ANY IMPLIED
WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. KozMos, INC. DOES NOT WARRANT THAT THE OPERATION
OF THE PROGRAM WILL BE UNINTERRUPTED OR ERROR FREE.

Public Function
 
Name
 (vlxls-variant->list VariantValue)
 
Usage
 Convert a variant into normal Visual LISP LIST data, nested Variant and safearray will also be converted.
 
Input
 VARIANT
 Input Variant
 
RetVal
 True
 LIST
 Valid Visual LISP variable value
 
Fail
 STR
 ""
 ;|;

(defun vlxls-variant->list (varx / run item rtn tt ) 
  (setq run t)
  (while run
   (setq tt (type varx))
   (cond ((= tt 'safearray)
          (setq varx (vlax-safearray->list varx))
         )
         ((= tt 'variant)
          (if (member (vlax-variant-type varx) (list 5 4 3 2))
              (setq varx (vlax-variant-change-type varx vlax-vbstring))
          )
          (setq varx (vlax-variant-value varx))
         )
         (t (setq run nil))
   )
  )
  (cond ((= (type varx) 'list)
         (foreach item varx
            (setq item (vlxls-variant->list item)
                  rtn (append rtn (list item))
             )
          )
          rtn
        )
        ((not varx) "")
        (varx)
  )
)
;;;***************** 函数 vlxls-variant->list*****************


;;;*************函数 vlxls-get-property.lsp  *************
 
;|
Examples:
(vlxls-rangevalue->safearray '(("A1" . "aaa")("B4" . "ccc"))) è#<safearray...>
(vlxls-variant->list (vlxls-rangevalue->safearray '(("A1" . "aaa")("B4" . "ccc"))))è(("aaa" "") ("" "") ("" "") ("" "ccc"))

Public Function
 
Name
 (vlxls-get-property TopVLAObject NestPropertyString)
 
Usage
 Get the property of a nested VLA-Object from the main top vla-object. Use same property indicator as VBA.
 
Input
 VLOBJ
 The Top vla-object
 
STRING
 The Property combination string, divided with ".", ordered from top to inner.
 
RetVal
 True
 ANY
 The value of the most nested property.
 
Fail
 BOOLEAN
 NIL
 ;|;

(defun vlxls-get-property ( top prop / vlstring->list item rtn tt)

  (defun vlstring->list (str st / lst e)
    (setq str (strcat str st))
    (while (vl-string-search st str)
        (setq lst (append lst (list (substr str 1 (vl-string-search st str))))
              str (substr str (+ 1 (strlen st) (vl-string-search st str)))
        )
    )
    (if lst (mapcar '(lambda (e) (vl-string-trim " " e)) lst))
  )

  (cond ((= (setq tt (type prop)) 'sym)
         (setq rtn (vlax-get-property top prop))
        )
        ((= tt 'str)
         (if (vl-string-search "." prop)
             (foreach item (vlstring->list prop ".")
                    (setq rtn (vlax-get-property (if rtn rtn top) item))
             )
             (setq rtn (vlax-get-property top prop))
         )
        )
  )
  (setq tt (type rtn))
  (cond  ((= tt 'variant) (vlax-variant-value rtn))
         ((= tt 'safearray) (vlxls-variant->list rtn))
		 (rtn)
  )       
)

;;;***************** 函数 vlxls-get-property*****************


;;;*************函数 gxl-strparse.lsp  *************
 ;_ end of defun



;;;*************函数 gxl-strparsebylst.lsp  *************
;; | ----------------------------------------------------------------------------
;; | (gxl-StrParseByLst 字串 分隔符表)
;; | ----------------------------------------------------------------------------
;; | Function : Splits up a string into a list of tokens delimited by a list of
;; |            delimiters and returns all white spaces in between the dlimiters
;; | Argument : [lstr]     - The String
;; |            [DelimLst] - The list of possible delimiters
;; | Return   : A list of delimited strings
;; | Updated  : January 29, 1999
;; | e-mail   : rakesh.rao@4d-technologies.com 
;; | Web      : www.4d-technologies.com
;; | ----------------------------------------------------------------------------
;;;(gxl-StrParseByLst "asdas;asdsad,asdasd.sad" '(";" "," ".")) 返回 '("asdas" "asdsad" "asdasd" "sad")

(defun gxl-strparsebylst ( lstr delimlst )
  (setq lstr (list lstr))
  (foreach del delimlst
     (setq lstr (apply 'append (mapcar '(lambda (x) (mai_str2lst2 x del)) lstr)))
  )
  (if (member " " delimlst)
      (vl-remove "" lstr)
      lstr
  )
)
;;;***************** 函数 gxl-StrParseByLst*****************










;;;*************函数 vlxls-rangeid.lsp  *************
;| 
Examples:
(vlxls-cellid '(3 14)) è ("C14" "")
(vlxls-cellid "23") è ("D23" "")
(vlxls-cellid "C12:F3") è ("C3" "F12")
(vlxls-cellid "F15:G22") è ("F15" "G22")
Excel Cell and Range Progress Function
 
Name
 (vlxls-rangeid CellIDStringOrList)
 
Usage
 VLXLS treats Excel Cell ID in two types: AutoCAD LIST and Excel simple Cell ID String. This function is used to convert Cell ID between the two types.
 
Input
 STR/LIST
 The Cell ID list or string
 
RetVal
 True
 STR/LIST
 Cell ID value in another VLXLS ID type
 
Fail
 BOOLEAN
 NIL
 
 |;
;;(vlxls-rangeid "A1")

(defun vlxls-rangeid ( id / str->list list->str xid->str tt )

  (defun str->list (str / ii xk xv rr pos x y)
    (setq rr (strlen str))
    (foreach ii '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
       (if (setq pos (vl-string-search ii str))
           (setq rr (min pos rr))
        )
    )
    (setq x (substr str 1 rr)
          y (substr str (1+ rr))
    )
    (if (= (strlen x) 2)
        (setq xk (- (ascii (substr x 1 1)) 64)
              xv (- (ascii (substr x 2)) 64)
        )  
        (setq xk 0
              xv (- (ascii x) 64)
        )
    )
    (list (+ (* xk 26) xv) (read y))
  )

  (defun xid->str (intnum / posnum nm-one)
    (setq nm-one (1- intnum)
          posnum (/ nm-one 26)
    )
    (if (= posnum 0)
        (chr (+ 65 (rem nm-one 26)))
        (strcat (chr (+ 64 posnum)) (chr (+ 65 (rem nm-one 26))))
    )
  )

  (defun list->str (idr / x y)
    (setq x (car idr)
          y (cadr idr)
          x (xid->str x)
          y (itoa y)
    )
    (strcat x y)
  )
  (setq tt (type id))
  (cond  ((= tt 'str) (str->list id))
         ((= tt 'list) (list->str id))

  )
)
;;;***************** 函数 vlxls-rangeid*****************


;;;*************函数 vlxls-color-eci-》aci.lsp  *************
 
;|Examples:

(vlxls-color-eci->truecolor 0) è16711935
(vlxls-color-eci->truecolor 1)è 0
(vlxls-color-eci->truecolor 12)è 8355584
(vlxls-color-eci->truecolor 120) è16711935
Color Transfer Function
 
Name
 (vlxls-color-eci->aci ExcelColorIndexNumber)
 
Usage
 Convert Excel ColorIndex number into most matched AutoCAD ACI Integer number.
 
Input
 INT
 Excel ColorIndex integer (0 to 56)
 
RetVal
 True
 INT
 Valid AutoCAD ACI Integer number (0 to 256)
 (vlxls-color-eci->aci 249)
Fail
 INT
 256 for BYLAYER
 ;|;

(defun vlxls-color-eci->aci ( color / rtn)
   (if (setq rtn (mai_dxf color *xls-color*)) (car rtn) 256)
)
;;;***************** 函数 vlxls-color-eci->aci*****************


;;;*************函数 vlxls-color-eci-》truecolor.lsp  *************
;|
Examples:
NONE
Color Transfer Function
Name
 (vlxls-color-eci->truecolor ExcelColorIndexNumber)
Usage
 Convert Excel ColorIndex number into most matched AutoCAD2004+ truecolor number (stored by DXF420).
Input
 INT
 Excel ColorIndex integer (0 to 56)
 (vlxls-color-ECI->truecolor 28)
RetVal
 True
 INT
 Valid AutoCAD 2004+ truecolor number
 
Fail
 INT
 16711935 for None
;|;
 
(defun vlxls-color-eci->truecolor ( color / rtn )
  (if (setq rtn (mai_dxf color *xls-color*))
      (setq rtn (cadr rtn))
  )
  (if rtn rtn 16711935)
)
;;;***************** 函数 vlxls-color-ECI->truecolor*****************


;;;*************函数 gxl-catchapply.lsp  *************
;;;(gxl-CatchApply fun args) 重定义 VL-CATCH-ALL-APPLY ,如函数错误返回nil
;;;(gxl-CatchApply vla-offset (list (vlax-ename->vla-object (car(entsel))) 10)) 
  ;; ?Lee Mac 2010
(defun gxl-CatchApply ( fun args / result )
  (if
    (not
      (vl-catch-all-error-p
        (setq result
          (vl-catch-all-apply (if (= 'SYM (type fun)) fun (function fun)) args)
        )
      )
    )
    result
  )
)
;;;***************** 函数 gxl-CatchApply*****************




;;;*************函数 vlxls-cellid.lsp  *************
;| 
Examples:
(vlxls-sheet-get-usedrange *xlapp* "Sheet1") è T
(vlxls-sheet- get-usedrange *xlapp* "NewSheet") è T
Excel Cell and Range Progress Function
Name
 (vlxls-cellid CellIDStringOrList)
Usage
 Divide complex Excel Cell ID into a two-string-item list, contain the Left-Upper and Right-Lower Cell ID.
If only one Cell ID is provided, set the Right-Lower Cell ID to "".
Input
 STR/LIST
 Complex Excel Cell ID string or simple Cell ID string/list.
RetVal
 True
 LIST
 List of Left-Upper and Right-Lower Cell ID
Fail
 BOOLEAN
 NIL
 ;|;

(defun vlxls-cellid (id / xx id1 id2 rtn )
  (if (= (type id) 'list)
      (setq id (vlxls-rangeid id))
  )
  (setq id (strcase id))
  (if (setq xx (vl-string-search ":" id))
      (setq id1 (vlxls-rangeid (substr id 1 xx))
            id2 (vlxls-rangeid (substr id (+ xx 2)))
            rtn (list (vlxls-rangeid (mapcar 'min id1 id2))
                      (vlxls-rangeid (mapcar 'max id1 id2))
                )
      )
      (list id "")
  )
)
;;;***************** 函数 vlxls-cellid*****************


;;;*************函数 vlxls-range-getid.lsp  *************
 
;|
Examples:
(vlxls-cell-get-mergeid *xlapp* "C12:F14") è"B9:G19"
(vlxls-cell-get-mergeid *xlapp* "E14") è"A11:G19"
Excel Cell and Range Progress Function
Name
 (vlxls-range-getid RangeObject)
Usage
 Get the Left-Upper and Right-Lower Cell ID of a range object.
Input
 VLOBJ
 The Excel Range vla-object
RetVal
 True
 STRING
 A string contain Left-Upper and Right-Lower cells’ ID
Fail
 BOOLEAN
 NIL
 ;|;

(defun vlxls-range-getid (range / col row dx dy )
  (setq dx (vlxls-get-property range "mergearea.rows.count")
        dy (vlxls-get-property range "mergearea.columns.count")
        row (vlxls-get-property range "mergearea.row")
        col (vlxls-get-property range "mergearea.column")
  )
  (strcat (vlxls-rangeid (list col row))
         ":"
         (vlxls-rangeid (list (1- (+ col dy)) (1- (+ row dx))))
  )
)
;;;***************** 函数 vlxls-range-getID*****************


;;;*************函数 gxl-ch_ent.lsp  *************
;;;==================================================================
;;;(gxl-CH_Ent ent i pt) 用新值pt更新图元ent索引i对应的值
;;;==================================================================

(defun gxl-ch_ent ( ent i pt / en )
  (setq en (entget ent)
       en (if (assoc i en)
              (subst (cons i pt) (assoc i en) en)
              (append en (list (cons i pt)))
          )
  )
  (entmod en)
  (entupd ent)
)
;;;***************** 函数 gxl-CH_Ent*****************


;;;*************函数 gxl-regexsearch.lsp  *************
;;(gxl-RegExSearch string Express key) 正则表达式搜索字串
;;参数 string = 字串
;;     Express = 正则表达式
;;     key = 字母 i I m M g G的组合字串
;;          i/I = 忽略大小写 m/M = 多行搜索 g/G = 全文搜索

(defun gxl-regexsearch (string express key / regex s pos len str l )
  (setq regex (vlax-create-object "vbscript.regexp"))
  (vlax-put-property regex "Global" (if (and key (wcmatch key "*g*,*G*")) 1 0))
  (vlax-put-property regex "IgnoreCase" (if (and key (wcmatch key "*i*,*I*")) 1 0))
  (vlax-put-property regex "Multiline" (if (and key (wcmatch key "*m*,*M*")) 1 0))
  (vlax-put-property regex "Pattern" express)
  (setq s (vlax-invoke regex 'Execute string))
  (vlax-for o s
    (setq pos (vlax-get-property o "FirstIndex")
          len (vlax-get-property o "Length")
          str (vlax-get-property o "value")
    )
    (setq l (cons (list pos len str) l))
  )
  (vlax-release-object RegEx)
  (reverse l)
)
;;;***************** 函数 gxl-RegExSearch*****************


;;;*************函数 gxl-regexreplace.lsp  *************
;;(gxl-RegExSearch string Express key) 正则表达式替换字串
;;参数 string = 字串
;;     Newstr = 替换的字串
;;     Express = 正则表达式
;;     key = 字母 i I m M g G的组合字串
;;          i/I = 忽略大小写 m/M = 多行搜索 g/G = 全文搜索
;;(gxl-RegExRePlace "ASasd32424\r\nasaf" "搜索" "as" "mg")
(defun gxl-regexreplace (string newstr express key / regex s)
  (setq regex (vlax-create-object "Vbscript.RegExp"))
  (vlax-put-property regex "Global" (if (and key (wcmatch key "*g*,*G*")) 1) 0)
  (vlax-put-property regex "IgnoreCase" (if (and key (wcmatch key "*i*,*I*")) 1 0))
  (vlax-put-property regex "Multiline"  (if (and key (wcmatch key "*m*,*M*")) 1 0))
  (vlax-put-property regex "Pattern" ExPress)
  (setq s (vlax-invoke regex 'RePlace string Newstr))
  (vlax-release-object RegEx)
  s
)
;;;***************** 函数 gxl-RegExRePlace*****************


;;;*************函数 gxl-str-padleft.lsp  *************
 ;_ defun
;;;(gxl-Str-PadLeft Str len char) 参数：字串 长度 填充字符  功能：字符串以len长度在前面填充字符

(defun gxl-str-padleft (str len char / _len str1 diff)
  (setq _len (strlen str)
        diff (- len _len)
        str1 ""
  )
  (if (>= diff 0) (repeat diff (setq str1 (strcat str1 char))))
  (strcat str1 str)
)
;;;***************** 函数 gxl-Str-PadLeft*****************




;;;*************函数 gxl-num-base-》decimal.lsp  *************


;;;==================================================================
;;;gxl-Num-Base->Decimal 将一个字符串按BASE的做为基数的进制转换为十进制的整数值。
;|
功能
将一个字符串按BASE的做为基数的进制转换为十进制的整数值。
参数
base:一个代表所要转换的进制(BASE2、BASE8等)基数整数。
val:一个进行转换的字符串。
返回值
十进制的整数值。
示例 (gxl-Num-Base->Decimal 2 "0011011")
(gxl-Num-Base->Decimal 16 "71063301") (gxl-Num-Base->Decimal 16 "1234567890abcdef")
;|;

;;;==================================================================
(defun gxl-num-base->decimal (base val / pos power result tmp)
  (setq pos (1+ (strlen val))
        power  -1
        result 0
        val (strcase val)
  )
  (while (> (setq pos (1- pos)) 0)
    (setq power (1+ power)
          tmp (ascii (substr val pos 1))
          result (+ result (* (- tmp (if (> tmp 64) 55 48)) (expt base power)))
    )
  )
  result
)
;;;***************** 函数 gxl-Num-Base->Decimal*****************


;;;*************函数 gxl-hex-》aci.lsp  *************
;;;(gxl-Hex->ACI Hex) 16位颜色转AutoCAD 256色颜色索引
;;;(gxl-Hex->ACI "#CC00FF") 
(defun gxl-hex->aci ( hex )
  (setq hex (gxl-str-padleft (vl-string-left-trim "#" hex) 6 "0"))
  (mai_rgb->aci
        (list (gxl-num-base->decimal 16 (substr hex 1 2))
              (gxl-num-base->decimal 16 (substr hex 3 2))
              (gxl-num-base->decimal 16 (substr hex 5 2))
        )
        nil
  )
)
;;;***************** 函数 gxl-Hex->ACI*****************


;;;*************函数 gxl-item.lsp  *************
;;;(gxl-Item coll item ) 重定义 Item
;;(gxl-Item (vlax-get (vlax-get (vlax-get-acad-object) 'ActiveDocument) 'blocks) "001")
(defun gxl-Item  ( coll item )
  (setq item (vl-catch-all-apply 'vla-item (list coll item)))
  (if (not (vl-catch-all-error-p item))
      item
  )
)
;;;***************** 函数 gxl-Item*****************










;;;*************函数 gxl-sel-ss-》vla.lsp  *************
;;;;;;gxl-sel-ss->vla 选择集转为Vla列表
(defun gxl-sel-ss->vla (ss / i l)
 (mapcar 'vlax-ename->vla-object (mai_ssget_2_list ss))
)
;;;***************** 函数 gxl-sel-ss->vla*****************


;;;*************函数 gxl-getsortentstable.lsp  *************
;;;(gxl-GetSortentsTable *MODEL-SPACE*) 获取AcDbSortentsTable 对象，参数：space 为ModelSpace or PaperSpace
(defun gxl-getsortentstable ( space / dict )
  (setq dict (vla-getextensiondictionary space))
  (cond ((gxl-catchapply vla-item (list dict "acad_sortents")))
        ((gxl-catchapply vla-addobject (list dict "acad_sortents" "acdbsortentstable")))
  )
)
;;;***************** 函数 gxl-GetSortentsTable*****************


;;;*************函数 gxl-num-objectvariant.lsp  *************

;;-------------------=={ Object Variant }==-------------------;;
;;                                                            ;;
;;  Creates a populated Object Variant                        ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst - list of VLA Objects to populate the Variant.        ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Object Variant                              ;;
;;------------------------------------------------------------;;
;;;(gxl-num-ObjectVariant vla对象表) 创建vla变体
(defun gxl-num-ObjectVariant ( lst )
  (vlax-make-variant
    (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length lst)))) lst)    
  )
)
;;;***************** 函数 gxl-num-ObjectVariant*****************


;;;*************函数 gxl-movetobottom.lsp  *************

;;;(gxl-MovetoBottom ss) 选择集或图元Ename、Vla对象 移到数据库最下显示 ，成功返回 T 失败返回 nil
;;;(gxl-MovetoBottom (ssget))
(defun gxl-movetobottom ( ss / objlst sortents ) (vl-load-com)
  (if vla-movetobottom
      (progn
        (setq objlst (gxl-sel-ss->vla ss))
        (if (setq sortents (gxl-getsortentstable (vla-objectidtoobject *acdocument* (vlax-get-property (car objlst) 'ownerid ))))
            (not (vla-movetobottom sortents (gxl-num-objectvariant objlst)))
        )
      )
      (progn
        (if (= 'vla-object (type ss)) (setq ss (vlax-vla-object->ename ss)))
        (command "_.draworder" ss "" "b")
      )
  )
)
;;;***************** 函数 gxl-MovetoBottom*****************


;;;*************函数 gxl-sel-ss-》ax：array.lsp  *************

;;;===================================================================
;;;gxl-Sel-SS->AX:Array 转换选择集为变体数组
;|功能  
转换选择集为变体数组  
语法  
(selectionsetToArray ss)  
参数  
ss: 选择集  
返回值  
变体数组  
样例  
(selectionsetToArray mySS)  
说明  
使用该函数可以将选择集转换为数组传递给ActiveX函数。
如果需要其它的子类型，只需更改引用vlax-vbObject。  
|;
;;;===================================================================
(defun gxl-Sel-SS->AX:Array ( ss )
  (setq ss (gxl-sel-ss->vla ss))
  (vlax-safearray-fill (vlax-make-safearray vlax-vbObject (cons 0 (1- (length ss)))) ss)
)
;;;***************** 函数 gxl-Sel-SS->AX:Array*****************


;;;*************函数 gxl-ax：addunnamegroup.lsp  *************
;;;(gxl-AX:AddUnNameGroup ss) 创建无名组 (gxl-AX:AddUnNameGroup (ssget))
(defun gxl-ax:addunnamegroup (ss / objgroup)
  (vla-appenditems (setq objgroup (vla-add (vlax-get *acdocument* 'groups) "*")) (gxl-sel-ss->ax:array ss))
  objgroup
)
;;;***************** 函数 gxl-AX:AddUnNameGroup*****************


;;;*************函数 gxl-ax：addblock.lsp  *************
;;;===================================================================
;;;(gxl-AX:AddBlock InsPt Name) 增加块定义(做块头)，返回块定义 OBJ
(defun gxl-AX:AddBlock (InsPt Name)
  (if (= (substr (strcase name) 1 2) "*U") (setq name "*U"))
  (vla-add (vlax-get-property *AcDocument* 'Blocks) (vlax-3d-point InsPt) Name)
)
;;;***************** 函数 gxl-AX:AddBlock*****************


;;;*************函数 gxl-str-subst.lsp  *************
 ;_ end of defun
;;; (gxl-Str-Subst New Old Str) 替换字符串中的某些字符为其它字符
;;;(gxl-Str-Subst  ",." ".." "123..456..789")
(defun gxl-Str-Subst (New Old Str / str1 n)
  (setq n (strlen old))
  (cond ((> (strlen str) n)
         (setq str1 (substr str 1 n))
         (if (= str1 old)
             (strcat new (gxl-Str-Subst new old (substr str (1+ n))))
             (strcat (substr str 1 1) (gxl-Str-Subst new old (substr str 2)))
         )
        )
        ((= (strlen str) n)
         (if (= old str) new str)
        )
        (t str)
  ) ;_ 结束cond
)
;;;***************** 函数 gxl-Str-Subst*****************





;;;*************函数 gxl-blk-unblockbase.lsp  *************
 ;_ defun
;;(gxl-BLK-UnBlockBase ss base) 制作无名块，base 为图块基点 或 0 = 中心 1 = 左下 2 = 右下 3 = 右上 4 = 左上 ，默认值为0
;;(gxl-BLK-UnBlockBase (ssget) 3)
(defun gxl-BLK-UnBlockBase ( ss base / obj blkName obj1 cp ll ur)
  (if (> (sslength ss) 0)
      (progn
        (setq blkname "*U"
              ss (gxl-sel-ss->ax:array ss)
              obj (gxl-ax:addblock '(0 0 0) blkname)
        )
        (vla-copyobjects *acdocument* ss obj)
        (foreach ss (vlax-safearray->list ss) (vl-catch-all-apply 'vla-delete (list ss)))
        (setq obj1 (gxl-ax:insertblock '(0 0 0) (vlax-get obj 'name) 1 1 1 0))
        ;;计算基点
        (cond
            ((= 'list (type base)) (setq cp base))
            ((or (null base) (= 0 base))
             (vla-GetBoundingBox obj1 'll 'ur)
             (setq cp (mai_divide_point (vlax-safearray->list ll) (vlax-safearray->list ur) 0.5))
            )
            ((= 1 base)
             (vla-GetBoundingBox obj1 'll 'ur)
             (setq cp (vlax-safearray->list ll))
            )
            ((= 2 base)
             (vla-GetBoundingBox obj1 'll 'ur)
             (setq cp (list (car (vlax-safearray->list ur)) (cadr (vlax-safearray->list ll)) 0))
            )
            ((= 3 base)
             (vla-GetBoundingBox obj1 'll 'ur)
             (setq cp (vlax-safearray->list ur))
            )
            ((= 4 base)
             (vla-GetBoundingBox obj1 'll 'ur)
             (setq cp (list (car (vlax-safearray->list ll)) (cadr (vlax-safearray->list ur)) 0))
            )
        )
        ;;修改图块基点
        (vlax-put obj 'Origin cp)
        (vla-move obj1 (vlax-3d-point '(0 0 0)) (vlax-3d-point cp))
         obj1
    )
  )
)
;;;***************** 函数 gxl-BLK-UnBlockBase*****************


;;;*************函数 vlxls-app-new.lsp  *************
 
;|Examples:

(vlxls-app-init)è 33
 

 

Excel Application Session Progress Function
 
Name
 (vlxls-app-new ShowExcelFlag)
 
Usage
 Open a new Excel session and start a new workbook.
 
Input
 BOOLEAN
 T for display, nil for hide
 
RetVal
 True
 VLOBJ
 Excel Session vla-object
 
Fail
 BOOLEAN
 NIL
 |;

(defun vlxls-app-new (unhide / rtn)
  (if (mai_cell_app_init)
    (progn
      (princ "\n 新建Excel工作表...")
      (or (vl-catch-all-error-p (setq rtn (vl-catch-all-apply 'vlax-get-or-create-object '("excel.application"))))
       (progn
         (vlax-invoke-method (vlax-get-property rtn 'workbooks) 'add)
         (vlax-put-property rtn 'visible (if unhide 1 0))
       )
      )
    )
  )
  rtn
)
;;;***************** 函数 vlxls-app-New*****************



;;;*************函数 vlxls-cellid-calc.lsp  *************

 
;|
Examples:
(vlxls-cell-put-value *xlapp* "C12" "xx") è #<VLA-OBJECT Range 093a7764>
(vlxls-cell-put-value *xlapp* "C12:F3" "5") è #<VLA-OBJECT Range 43c5ac64>
(vlxls-cell-put-value *xlapp* "C12:D13" '(("zz" 2)("xx" 31))) è #<VLA-OBJECT Range 1b8f2a64>
Excel Cell and Range Progress Function
Name
 (vlxls-cellid-calc BaseCellId XOffset YOffset)
Usage
 Calculate a new Cell ID for given delta X and Y from base Cell ID.
Input
 STR/LIST
 Base Cell ID string or list
INT
 X offset integer of Cell ID
INT
 Y offset integer of Cell ID
RetVal
 True
 STRING
 An Excel Complex Cell ID format contain the base Cell ID and target Cell ID.
Fail
 BOOLEAN
 NIL
 ;|;

(defun vlxls-cellid-calc (id x y / idx)
  (setq id (car (vlxls-cellid id))
        idx (vlxls-rangeid id)
        x (max 1 (+ x (car idx)))
        y (max 1 (+ y (cadr idx)))
        idx (vlxls-rangeid (list x y))
        id  (vlxls-cellid (strcat id ":" idx))
        id  (strcat (car id) ":" (cadr id))
  )
)
;;;***************** 函数 vlxls-cellid-calc*****************


;;;*************函数 vlxls-cell-put-value.lsp  *************
;| 
Examples:

(vlxls-cell-get-value *xlapp* "C12") è "g"

(vlxls-cell-get-value *xlapp* "C12:C12") è "g"

(vlxls-cell-get-value *xlapp* "C12:C15") è (("g") ("") ("") (""))

(vlxls-cell-get-value *xlapp* "C12:F12") è (("g" "ds" "" ""))

(vlxls-cell-get-value *xlapp* "C12:F15") è (("g" "ds" "" "") ("" "" "g" "") ("" "" "" "") ("" "" "" ""))
 

 

Excel Cell and Range Progress Function
 
Name
 (vlxls-cell-put-value ExcelSessionVLA-OBJECT CellIDStringOrList DataList)
 
Usage
 Pass a 1 dimension or a 2 dimension string list into Excel, started at certain Cell ID.
 
Input
 VLOBJ
 The Excel Session vla-object
 
STR/LIST
 The start Cell ID [Left-Upper] list or string
 
STR/LIST
 If this argument is a string, VLXLS will fill same string to all cells.

Or the argument should be a 1 dimension list or a 2 dimension list to fill in Excel. If the data list can NOT match the
given cell ID, VLXLS will only fill first cell, fill to other cells will be ignored.
 
RetVal
 True
 VLOBJ
 All Excel Range vla-object that just be filled in by given data list
 
Fail
 BOOLEAN
 NIL
 ;|;
(defun vlxls-cell-put-value (xl id data / vllist-explode idx xx yy ary rtn)
    (or id (setq id "a1"))
    (if (= (type id) 'list)
        (setq id (vlxls-rangeid id))
    )
    (if (atom data) (setq data (list data)))
    (if (= (type (car data)) 'list)
        (setq ary (vlax-make-safearray vlax-vbvariant (cons 0 (1- (length data))) (cons 1 (length (car data)))) ;vlax-vbstring
              xx  (1- (length (car data)))
              yy  (1- (length data))
              ary (vlax-make-safearray vlax-vbvariant (cons 0 1) (cons 1 (length data))) ;vlax-vbstring 
              xx (1- (length data))
              yy 0
        )
    )
    (if (= xx yy 0)
        (msxlp-put-value2
            (setq rtn (msxlp-get-range xl id))
            (car (mai_list_flat data))
        )
        (progn
            (setq id (vlxls-cellid-calc id xx yy))
            (msxlp-put-value2
                 (setq rtn (msxlp-get-range xl id))
                 (vlax-safearray-fill ary data)
            )
        )
    )
    Rtn
)
;;;***************** 函数 vlxls-cell-put-value*****************


;;;*************函数 vlxls-range-autofit.lsp  *************
 
;|Examples:

(vlxls-rangeid '(3 14)) è "C14"

(vlxls-rangeid "D23") è (4 23)

(vlxls-rangeid "DD23") è (108 23)
 

 

Excel Cell and Range Progress Function
 
Name
 (vlxls-range-autofit RangeVLA_OBJECT)
 
Usage
 Autofit the column width of a certain range object.
 
Input
 VLOBJ
 The Excel Range vla-object
 
RetVal
 True
 BOOLEAN
 T
 
Fail
 BOOLEAN
 NIL
 ;|;

(Defun vlxls-range-autofit (range)
  (equal (vlax-variant-value (msxl-autofit (msxlp-get-columns (msxlp-get-Cells range))))
        :vlax-true
  )
)
;;;***************** 函数 vlxls-range-autofit*****************


;;;*************函数 vlxls-sheet-get-usedrange.lsp  *************
;| 
Examples:

(vlxls-sheet-put-active *xlapp* "Sheet1") è T

(vlxls-sheet-put-active *xlapp* "NewSheet") è T
 

 

Excel Sheet Progress Function
 
Name
 (vlxls-sheet-get-usedrange ExcelSessionVLA-OBJECT SheetName)
 
Usage
 Get all used range of certain Excel sheet. If sheet name not exist, return NIL.
 
Input
 VLOBJ 
 Excel session vla-object
 
STRING
 Excel sheet name string, NIL for current active sheet.
 
RetVal
 True
 VLOBJ
 Excel Range vla-object
 
Fail
 BOOLEAN
 NIL
 ;|;

(Defun vlxls-sheet-get-UsedRange (xlapp Name / sh Rtn)
  (or Name
      (setq Name (vlax-get-property (msxlp-get-ActiveSheet Xlapp) 'Name))
  )
  (vlax-for sh (vlax-get-property Xlapp "sheets")
    (if (= (vlax-get-property sh "Name") Name)
        (setq Rtn (vlax-get-property sh "UsedRange"))
    )
  )
  Rtn
)
;;;***************** 函数 vlxls-sheet-get-UsedRange*****************


;;;*************函数 vlxls-app-quit.lsp  *************
 
;|Examples:

(vlxls-app-saveas *xlapp* nil) è "C:/Temp-Folder/XLS.XLS"

(vlxls-app-saveas *xlapp* "C:/Temp-Folder/XLS.XLS") è "C:/Temp-Folder/XLS.XLS"

(vlxls-app-saveas *xlapp* nil) è NIL
 

 

Excel Application Session Progress Function
 
Name
 (vlxls-app-quit ExcelSessionVLA-OBJECT SavedFlag)
 
Usage
 Quit active workbook of Excel session and release Excel application.
 
Input
 VLOBJ
 Excel session vla-object
 
BOOLEAN
 Save Excel active workwook flag, T for save, NIL for unsave
 
RetVal
 True
 BOOLEAN
 NIL
 
Fail
 BOOLEAN
 NIL
 ;|;

(Defun vlxls-app-quit (ExlObj SaveYN)
  (if SaveYN
      (vlax-invoke-method (vlax-get-property ExlObj "ActiveWorkbook") 'Close)
      (vlax-invoke-method (vlax-get-property ExlObj "ActiveWorkbook") 'Close :vlax-False)
  )
  (if (= 0 (vlax-get-property (vlax-get-property ExlObj "Workbooks") "count"))
      (progn
          (vlax-invoke-method ExlObj 'QUIT)
          (vlax-release-object ExlObj)
          (setq ExlObj nil)
      )
  )
  (gc)
)
;;;***************** 函数 vlxls-app-quit*****************
(setq *xls-color*
       (list (list 1 18 0)
         (list 2 7 1677215)
         (list 3 1 16711680)
         (list 4 3 65280)
         (list 5 5 255)
         (list 6 2 16776960)
         (list 7 6 16711935)
         (list 8 4 65535)
         (list 9 16 8323072)
         (list 10 96 32512)
         (list 11 176 127)
         (list 12 56 8355584)
         (list 13 216 8323199)
         (list 14 136 32639)
         (list 15 9 12566463)
         (list 16 8 8355711)
         (list 17 161 9476095)
         (list 18 237 9449568)
         (list 19 7 1677167)
         (list 20 254 12648447)
         (list 21 218 6291552)
         (list 22 11 16744319)
         (list 23 152 24768)
         (list 24 254 13617407)
         (list 25 176 127)
         (list 26 6 16711935)
         (list 27 2 16776960)
         (list 28 4 65535)
         (list 29 216 8323199)
         (list 30 16 8323072)
         (list 31 136 32639)
         (list 32 5 255)
         (list 33 140 51455)
         (list 34 254 12648447)
         (list 35 254 13631439)
         (list 36 51 16777104)
         (list 37 151 9488639)
         (list 38 221 16750799)
         (list 39 191 13605119)
         (list 40 31 16763024)
         (list 41 150 3105023)
         (list 42 132 3131584)
         (list 43 62 9488384)
         (list 44 40 16762880)
         (list 45 30 16750336)
         (list 46 30 16738048)
         (list 47 165 6317968)
         (list 48 252 9475984)
         (list 49 148 12384)
         (list 50 105 3184736)
         (list 51 98 12032)
         (list 52 48 3158016)
         (list 53 24 9449472)
         (list 54 237 9449311)
         (list 55 177 3158160)
         (list 56 250 3092527)
       )
)

;;;*************************************************
;;(c:x2c)
;;(princ "\nExcel表格 To CAD By Gu_xl 命令: X2C 2013.06.09 ")
(defun c:gu_x2c (  /  old_cmd  *xlapp*          act_annocolor act_blayer      act_cellcolor
        act_getfile   act_group        act_keeptheight
        act_merge     act_none        act_pagesetup act_printarea
        act_tlayer    act_ublock    act_used      act_user
        basepoint     cells        col          curpt
        old_dcl_load   tmp_dcl       dd        defaultheight drawpagesetup
        dxf40          dxf420        dxf62      dxf7
        dxf71          dxf71data        ecode      endent
        font          get9justpts   getrangetextstyle
        gridscale     height        height1
        horizontalalignment        horline      hpagebreaks
        interiorcolor interiortruecolor          layers
        mergeid          mergep        mktmpdcl      
        oldheight     oldrow        p0          p1
        p2          p3        page      pagemargin
        pagesetup     printarea        printtitlerows
        range          rangefont        righttoppt      row
        s1          scale        selection      sheet
        ss          standardfont  standardfontsize
        start_xl2x    startpoint    text      textfont
        textpt          textverflag   tmp 
        totalheight   totalpage        totalwide      usedrange
        verlines      verticalalignment          width
        width1          workbook        workbooks      act_range
        act_theight   blayer        caption      cfont
        char          charfont        f
        horizontalalignmen        i          ii
        interiorcolor1            kd          sstitle
        tlayer          tmppt        verline      titlerows
        tmp          tmp1        *drawrange*      *cellcolor*
        *annocolor*   *oprate*        *merge*      *theight*
        *keeptheight* *pagesetup*   *defaultcolor* sssolid
           )
     (mai_last_com "gu_x2c")
          
  ;;计算九宫格点
  (defun Get9JustPts (LL UR / tmp BC BL BR MC ML MR TC TL TR)
    (setq
      LL (list (car LL) (cadr LL) 0.0)
      UR (list (car UR) (cadr UR) 0.0)
      BL LL
      TR UR
      MC (mai_divide_point BL TR 0.5)
      TL (list (car BL) (cadr TR) 0.0)
      TC (list (car MC) (cadr TR) 0.0)
      MR (list (car TR) (cadr MC) 0.0)
      BR (list (car TR) (cadr BL) 0.0)
      BC (list (car MC) (cadr BL) 0.0)
      ML (list (car BL) (cadr MC) 0.0)
      )
    (list TL TC TR ML MC MR BL BC BR)
    )
 ;;创建临时对话框 
 (defun mktmpdcl ()
   (mai_make_dcl
       (list "xl2cad:dialog{label=\"Excel 转CAD表格 【Gu_xl】\";"
                ":boxed_radio_column{key=\"Range\" ;label=\"Excel数据范围\";"
                    ":radio_button{key=\"Used\";label=\"所有使用的单元格\";}"
                    ":radio_button{key=\"User\";label=\"用户选定的单元格\";}"
                    ":radio_button{key=\"PrintArea\";label=\"页面可打印区域\";}}"
                ":button{alignment=left;fixed_height=true;fixed_width=true;key=\"getfile\";label=\"选择Excel文件->\";width=20;}"
                ":boxed_column{label=\"生成设定\";"
                    ":row{:toggle{key=\"CellColor\";label=\"单元格背景颜色\";}"
                         ":toggle{key=\"AnnoColor\";label=\"文 本 颜 色\";}}"
                    ":row{:toggle{key=\"PageSetup\";label=\"按页面设置输出\";}"
                         ":toggle{key=\"Merge\";label=\"合并表格线\";}}"
                    ":row{:toggle{key=\"KeepTHeight\";label=\"缺省文本高度\";}"
                         ":edit_box{key=\"THeight\";label=\"\";}}"
                    ":boxed_radio_row{key=\"Gather\";label=\"实体集合\";"
                        ":radio_button{key=\"None\";label=\"无操作\";}"
                        ":radio_button{key=\"Group\";label=\"无名组\";}"
                        ":radio_button{key=\"UBlock\";label=\"无名块\";}}"
                    ":boxed_column{label=\"实体图层\";"
                        ":popup_list{edit_width=15;key=\"BLayer\";label=\"单元格线:\";}"
                        ":popup_list{edit_width=15;key=\"TLayer\";label=\"表格内容:\";}"
                        ":row {:radio_button{key=\"ByLayer\";label=\"颜色随层\";}"
                              ":radio_button{key=\"ByBlock\";label=\"颜色随块\";}}}}ok_cancel_help;errtile;}"
        )
   )
  )
  ;;
 (defun start_xl2x ()
   (or (setq *DrawRange* (getenv "Excel2CAD\\DrawRange"))
       (progn
          (setq *DrawRange* "Used")
          (setEnv "Excel2CAD\\DrawRange" *DrawRange*)
       )
   )
   (set_tile *DrawRange* "1")
   (mai_filldcl_list "BLayer" Layers)
   (mai_setdcl_popup "BLayer" "0" Layers)
   (setq blayer (car layers))
   (mai_filldcl_list "tlayer" Layers)
   (mai_setdcl_popup "tlayer" "0" Layers)
   (setq tlayer (car layers)
         *CellColor* (= "1" (getenv "Excel2CAD\\CellColor"))
   )
   (if *CellColor*
       (set_tile "CellColor" "1") ;_ 背景颜色
       (progn
           (set_tile "CellColor" "0") ;_ 背景颜色
           (setEnv "Excel2CAD\\CellColor" "0")
       )
   )
   (setq *AnnoColor* (= "1" (getenv "Excel2CAD\\AnnoColor")))
   (if *AnnoColor*
       (set_tile "AnnoColor" "1") ;_ 文本颜色
       (progn
           (set_tile "AnnoColor" "0") ;_ 文本颜色
           (setEnv "Excel2CAD\\AnnoColor" "0")
       )
   )
   (setq *Oprate* (getenv "Excel2CAD\\Oprate")
         *Oprate* (if *Oprate* (atoi *Oprate*) 0)
   )
   (setenv "Excel2CAD\\Oprate" (itoa *Oprate*))
   (cond
       ((or (null *Oprate*) (= 0 *Oprate*))
        (setq *Oprate* 0)
        (set_tile "None" "1")
       )
       ((= 1 *Oprate*)
        (set_tile "Group" "1")
       )
       ((= 2 *Oprate*)
        (set_tile "UBlock" "1")
       )
   ) 
   (setq *Merge* (= "1" (getenv "Excel2CAD\\Merge")))
   (if *Merge*
      (set_tile "Merge" "1")
      (progn
          (set_tile "Merge" "0")
          (Setenv "Excel2CAD\\Merge" "0")
      )
   )
   (setq *THeight* (getenv "Excel2CAD\\THeight"))
   (if *THeight*
       (setq *THeight* (atof *THeight*))
       (progn
           (setq *THeight* 300)
           (Setenv "Excel2CAD\\THeight" "300")
       )
   )
   (set_tile "THeight" (rtos *THeight* 2))
   (setq *KeepTHeight* (= "1" (getenv "Excel2CAD\\KeepTHeight")))
   (if *KeepTHeight*
       (progn
           (mode_tile "THeight" 0)
           (set_tile "KeepTHeight" "1")
       )
       (progn
           (mode_tile "THeight" 1)
           (set_tile "KeepTHeight" "0")
           (Setenv "Excel2CAD\\KeepTHeight" "0")
        )
    )
   (setq *pageSetUp* (= "1" (getenv "Excel2CAD\\pageSetUp")))
   (if *pageSetUp*
       (set_tile "PageSetup" "1")
       (progn
           (set_tile "PageSetup" "0")
           (Setenv "Excel2CAD\\PageSetup" "0")
       )
   )
   (setq *defaultColor* (getenv "Excel2CAD\\defaultColor"))
   (if *defaultColor*
       (setq *defaultColor* (atoi *defaultColor*))
       (progn
           (setq *defaultColor* 0)
           (Setenv "Excel2CAD\\defaultColor" "0")
       )
   )
   (cond
       ((= 0 *defaultColor*) (set_tile "ByBlock" "1"))
       (t (set_tile "ByLayer" "1") (setq *defaultColor* 256))
   )
 ;;控件控制动作
   (action_tile "getfile" "(act_getfile)")
   (action_tile "Used" "(act_Used $key $value $reason)")
   (action_tile "PrintArea" "(act_PrintArea $key $value)")
   (action_tile "User" "(act_User $key $value $reason)")
   (action_tile "CellColor" "(act_CellColor $key $value $reason)")
   (action_tile "AnnoColor" "(act_AnnoColor $key $value $reason)")
   (action_tile "PageSetup" "(act_PageSetup $key $value)")
   (action_tile "Merge" "(act_Merge $key $value $reason)")
   (action_tile "KeepTHeight" "(act_KeepTHeight $value)")
   (action_tile "THeight" "(setq *THeight* (gxl-chkrealp $value $key 6)) (if *THeight* (Setenv \"Excel2CAD\\\\THeight\" (rtos *THeight* 2)))")
   (action_tile "Gather" "(act_Gather $key $value $reason)")
   (action_tile "None" "(act_None $key $value $reason)")
   (action_tile "Group" "(act_Group $key $value $reason)")
   (action_tile "UBlock" "(act_UBlock $key $value $reason)")
   (action_tile "BLayer" "(act_BLayer $key $value $reason)")
   (action_tile "TLayer" "(act_TLayer $key $value $reason)")
   (action_tile "ByBlock" "(setq *defaultColor* 0) (Setenv \"Excel2CAD\\\\defaultColor\" \"0\")")
   (action_tile "ByLayer" "(setq *defaultColor* 256) (Setenv \"Excel2CAD\\\\defaultColor\" \"256\")")
   (action_tile "help" "(alert \"***Excel To AutoCAD*** \n\n版权所有:Gu_xl \n\n联系方式:Gu_xl@sohu.com\n\n\")")
 )
 
 
  ;;act_getfile动作
  (defun act_getfile (/ filename)
    (setq filename (getfiled "" "" "xls;xlsx" 4))
    (if filename (setq *xlapp* (vlxls-app-open filename t)))
  )

  ;;控件 Used 动作
    (defun act_Used (key val reason)
      (setq *DrawRange* key)
      (setEnv "Excel2CAD\\DrawRange" key)
    )

  ;;控件 User 动作
    (defun act_User (key val reason)
      (setq *DrawRange* key)
      (setEnv "Excel2CAD\\DrawRange" key)
    )
   (defun act_PrintArea (key val)
     (setq *DrawRange* key)
     (setEnv "Excel2CAD\\DrawRange" key)
   )
  ;;控件 CellColor 动作
    (defun act_CellColor (key val reason)
      (setq *CellColor* (= "1" val))
      (setEnv "Excel2CAD\\CellColor" val)
    )

  ;;控件 AnnoColor 动作
    (defun act_AnnoColor (key val reason)
      (setq *AnnoColor* (= "1" val))
      (setEnv "Excel2CAD\\AnnoColor" val)
    )
 ;;按页面设置输出
    (defun act_PageSetup (key val)
       (setq *PageSetUp* (= "1" val))
       (setEnv "Excel2CAD\\PageSetup" val)
    )
  ;;控件 Merge 动作
    (defun act_Merge (key val reason)
      (setq *Merge* (= "1" val))
      (setEnv "Excel2CAD\\Merge" val)
    )


  ;;控件 None 动作
    (defun act_None (key val reason)
      (setq *Oprate* 0)
      (set_tile "None" "1")
      (setEnv "Excel2CAD\\Oprate" "0")
    )

  ;;控件 Group 动作
    (defun act_Group (key val reason)
      (setq *Oprate* 1)
      (set_tile "Group" "1")
      (setEnv "Excel2CAD\\Oprate" "1")
    )

  ;;控件 UBlock 动作
    (defun act_UBlock (key val reason)
      (setq *Oprate* 2)
      (set_tile "UBlock" "1")
      (setEnv "Excel2CAD\\Oprate" "2")
    )
  ;;缺省文本高度
    (defun act_KeepTHeight (val)
      (setq *KeepTHeight* (= "1" val))
      (setEnv "Excel2CAD\\KeepTHeight" val)
      (mode_tile "THeight" (if *KeepTHeight* 0 1))
    )
  ;;控件 BLayer 动作
    (defun act_BLayer (key val reason)
      (setq BLayer (nth (read val) layers))
    )

  ;;控件 TLayer 动作
    (defun act_TLayer (key val reason)
      (setq TLayer (nth (read val) layers))
    )
  ;;绘制顶端标题
  (defun printtitlerows ( range / r        printarea    
               cells    col         row
               mergep    width         height
               text        font         horizontalalignment
               verticalalignment         dxf71
               dxf62    dxf420         rangefont
               dxf7        textfont     dxf40
               textverflag    tmp         oldrow
               p0         
               righttoppt    oldheight    mergeid
               width1    height1         p1
               p2        p3         horline
               verlines    interiorcolor
               interiortruecolor         textpt
                         columns
              )
    (setq r (vlxls-get-property *xlapp* "ActiveSheet.PageSetup.PrintTitleRows"))
    (if (/= "" r)
        (progn
          (setq r (mai_str2lst2 r ":"))
          (vlax-for a (vlxls-get-property range "Columns")
            (setq Columns (cons (vlxls-get-property a "Column") Columns))
          )
          (setq Columns (reverse Columns)
                r (strcat (chr (+ 64 (car Columns))) (car r) ":" (chr (+ 64 (last Columns))) (last r))
                range (vlax-get-property *xlapp* 'range r)
                cells (vlax-get-property range 'cells)
          )
        ;;逐个绘制表头，未完成
          (vlax-for cell cells
            (setq col (vlax-get-property cell 'column)
                  row (vlax-get-property cell 'row)
                  range (msxlp-get-range *xlapp* (vlxls-rangeid (list col row)))
                  Mergep (equal :vlax-true (vlax-variant-value (vlax-get-property cell 'MergeCells)))
                  height (* defaultHeight GridScale)
                  width (* height (vlax-variant-value (vlax-get-property cell 'width)))
                  height (* height (vlax-variant-value (vlax-get-property cell 'height)))
                  text (vlax-variant-value (vlax-get-property cell 'text))
            )
            (and (/= text "")
                 (not (equal width 0 0.01))
                 (progn
                    (setq font (vlax-get-property range 'font)
                          dxf71 (vlax-variant-value (vlax-get-property Cell 'HorizontalAlignment))
                          HorizontalAlignment (cond ((= dxf71 -4152) 2) ;_ 右
                                                    ((= dxf71 -4108) 1) ;_ 中
                                                    (0) ;_ 左
                                              )
                          dxf71 (vlax-variant-value (vlax-get-property Cell 'VerticalAlignment))
                          VerticalAlignment (cond ((= dxf71 -4160) 0) ;_ 上
                                                  ((= dxf71 -4108) 1) ;_ 中
                                                  (2) ;_ 下
                                            )
                          dxf71 (nth verticalalignment (nth horizontalalignment dxf71data))
                          dxf62 (vlxls-color-eci->aci (vlax-variant-value (vlax-get-property font 'colorindex)))
                          dxf420 (vlxls-color-eci->truecolor (vlax-variant-value (vlax-get-property font 'colorindex)))
                          ;;计算Range的字体 RangeFont i ii char cfont charFont caption f TextVerFlag
                          RangeFont
                            (mapcar
                               '(lambda (x) (cons x (vlxls-get-property font x)))
                               '("name" "size" "colorindex" "bold" "italic" "subscript" "superscript" "underline")
                            )
                          dxf7 (mai_dxf "NAME" RangeFont)
                    )
                    (or dxf7 (setq dxf7 standardFont))
                    ;;字体
                    (setq textfont (strcat "{\\f" dxf7 "|b0|i0|c134|p0;")
                          Dxf40 (mai_dxf "SIZE" RangeFont)
                    )
                    (or dxf40 (setq dxf40 standardfontsize))
                    ;;字大小
                    (setq textFont (strcat textFont "\\H" (rtos dxf40 2 1) "x;"))
                    ;;加粗
                    (if (equal :vlax-true (mai_dxf "BOLD" rangefont))
                        (setq textfont (strcat textFont "\\W1.2;"))
                    )
                    ;;倾斜
                    (if (equal :vlax-true (mai_dxf "ITALIC" rangefont))
                        (setq textfont (strcat textFont "\\Q18;"))
                    )
                    ;;下划线
                    (if (= 2 (mai_dxf "UNDERLINE" RangeFont))
                        (setq textfont (strcat textFont "\\L"))
                    )
                    ;;上标 "SUPERSCRIPT"
                    ;;下标 "SUBSCRIPT"
                    ;;文字是否竖向
                    (setq textverflag (= (gxl-catchapply vlxls-get-property (list range "Orientation")) -4166))
                    (if TextVerFlag
                        (setq text (mai_lst2str (mai_str2lst text "") "\\P"))
                    )
                    ;;逐字取样式
                    ;;(setq textFont (strcat textFont (GetRangeTextStyle RANGE RANGEFONT text) "}"))

                   (setq text (strcat textFont text "}"))
                )
            )
            (cond ((null OldRow) (setq OldRow Row))
                  ((/= OldRow Row) ;_ 换行
                   (setq OldRow Row
                         StartPoint (mai_point_offset StartPoint 0 oldheight)
                         Curpt StartPoint
                   )
                  )
            )
            (setq oldheight height)
            (if (not (equal width 0 0.01))
                (progn
                    (setvar "clayer" Blayer)
                    (setvar "cecolor" *defaultColor*)
                    (if Mergep
                        (setq mergeid (mapcar 'vlxls-rangeid (vlxls-cellid (vlxls-range-getid range)))
                              height1 (* defaultheight gridscale)
                              width1 (* height1 (vlxls-get-property range "MergeArea.width"))
                              height1 (* height1 (vlxls-get-property range "MergeArea.height"))
                        )
                        (setq width1 width
                              height1 height
                        )
                    )
                   (if (or (not Mergep)
                           (equal (car mergeId) (list col row))
                       )
                       (progn
                           (setq p0 (mai_point_offset Curpt 0 (- height1))
                                 p1 Curpt
                                 p2 (mai_point_offset Curpt width1 0)
                                 p3 (mai_point_offset p2 0 (- height1))
                           ) ;_ 框的四个角点 左下、左上、右上、右下
                           (if *Merge*
                               (progn
                                    (if (and Horline
                                             (equal p1 (mai_dxf 11 HorLine) 1e-3)
                                        )
                                        (gxl-ch_ent HorLine 11 p2) ;_ 更新水平直线末端点
                                        (setq Horline (mai_entmake "line" (list p1 p2)))
                 
                                    )
                                    (or (and VerLines
                                             (vl-some '(lambda(x) (if (equal p1 (mai_dxf 11 x) 1e-3) (gxl-ch_ent x 11 p0))) ;_ 更新垂直直线末端点
                                                      VerLines
                                             )
                                        )
                                        (setq VerLines (mai_entmake "line" (list p1 p0)))
                                    ) ;if
                                ) ;progn
                                (mai_entmake "LWPOLYLINE" (list p0 p1 p2 p3 p0))
                            )
                            (and *CellColor* ;_ 绘制背景颜色
                                 (/= -4142 (setq interiorcolor (vlxls-get-property range "Interior.ColorIndex")))
                                 (progn
                                    (setq Interiorcolor (vlxls-color-eci->aci interiorcolor)
                                          interiortruecolor (vlxls-color-eci->truecolor Interiorcolor)
                                    )
                                    (setvar "cecolor" Interiorcolor)
                                    (mai_entmake "SOLID" (list p0 p1 p2 p3))
                                 )
                            )
                            (if (/= "" text)
                                (progn
                                    (setq textpt (nth (1- dxf71) (get9justpts p0 p2)))
                                    (cond ((= 0 HorizontalAlignment) ;_ 左对齐
                                           (setq textpt (mai_point_offset textpt (* height 0.1) 0))
                                          )
                                          ((= 2 HorizontalAlignment) ;_ 右对齐
                                           (setq textpt (mai_point_offset textpt (* height -0.1) 0))
                                          )
                                    )
                                    (cond ((= 0 VerticalAlignment) ;_ 上对齐
                                           (setq textpt (mai_point_offset textpt 0 (* height -0.1)))
                                          )
                                          ((= 2 VerticalAlignment) ;_ 下对齐
                                           (setq textpt (mai_point_offset textpt 0 (* height 0.1)))
                                          )
                                    )
                                    (entmake
                                       (vl-remove nil
                                            (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0)  (cons 8 TLayer)
                                                  (cons 62 (if *AnnoColor* dxf62 *defaultColor*))
                                                  '(100 . "AcDbMText") (cons 10 (trans textpt 1 0)) (cons 40 defaultHeight)
                                                  (cons 41 width1) (cons 71 DXF71) (cons 72 5) (cons 1 text)
                                                  (cons 7 "Standard") '(210 0.0 0.0 1.0) '(11 1.0 0.0 0.0) '(50 . 0.0) '(73 . 1)
                                            )
                                       )
                                    )
                                )
                            )
                        )
                    )
                    (setq Curpt (mai_point_offset Curpt width 0))
                )
            );if
        
        ) ;vlax-for
        (setq startpoint (mai_point_offset startpoint 0 (- oldheight)) curpt startpoint)
      )
    )
  )
  
  
  ;;Range的text逐字取样式
  (defun getrangetextstyle (range rangefont text        /         i
                  ii       char        cfont    caption
                  charfont f        textfont
                 )
    (if (equal :vlax-false (vlxls-get-property range "HasFormula"))
        (progn
            (setq i 0
                  ii (GXL-CATCHAPPLY vlax-get-property (list (vlax-get-property range 'characters) 'count))
            )
            (if ii
                (repeat ii
                    (setq i (1+ i)
                          char (vlax-get-property range 'characters i 1)
                          cfont (vlax-get-property char 'font)
                          caption (vlxls-get-property char "caption")
                          charFont
                             (mapcar
                               '(lambda (x) (cons x (vlxls-get-property cfont x)))
                               '("NAME" "SIZE" "COLORINDEX" "BOLD" "ITALIC" "SUBSCRIPT" "SUPERSCRIPT" "UNDERLINE")
                             )
                    )
                    (and (setq f (mai_dxf "NAME" charFont))
                         (/= f (mai_dxf "NAME" RangeFont))
                         (setq textfont (strcat "\\f" f "|b0|i0|c134|p0;"))
                    ) ;_ 字体
                    (and (setq f (mai_dxf "SIZE" charFont))
                         (equal f (mai_dxf "SIZE" RangeFont) 0.01)
                         (setq textfont (strcat textFont "\\H" (rtos f 2 1) "x;"))
                    ) ;_ 大小
                    (and (setq f (mai_dxf "COLORINDEX" charFont))
                         (equal f (mai_dxf "COLORINDEX" RangeFont) 0.01)
                         (setq textfont (strcat textFont "\\C" (itoa (vlxls-color-eci->aci f)) ";"))
                    ) ;_ 颜色
                    ;;加粗
                    (setq f (mai_dxf "BOLD" charFont))
                    (or (equal f (mai_dxf "BOLD" RangeFont))
                        (setq textfont (strcat textFont (if (equal :vlax-true f) "\\W1.2;" "\\W0.83;")))
                    )
                    ;;倾斜
                    (setq f (mai_dxf "ITALIC" charFont))
                    (or (equal f (mai_dxf "ITALIC" RangeFont))
                        (setq textfont (strcat textFontc(if (equal :vlax-true f) "\\Q18;" "\\Q0;")))
                    )
                    ;;上标
                    (if (equal :vlax-true (mai_dxf "SUPERSCRIPT" RangeFont))
                        (setq textFont (strcat textFont "\\H0.33x;\\A2;"))
                    )
                    ;;下标
                    (if (equal :vlax-true (mai_dxf "SUPERSCRIPT" RangeFont))
                        (setq textFont (strcat textFont "\\H0.33x;\\A0;"))
                    )
                    ;;下划线
                    (setq f (mai_dxf "UNDERLINE" charFont))
                    (or (equal f (mai_dxf "UNDERLINE" RangeFont))
                        (setq textfont (strcat textFont (if (= 2 f) "\\L" "\\l")))
                    )
                    (setq textFont (strcat textFont caption))
                    (and TextVerFlag (/= i ii) (setq textFont (strcat textFont "\\P")))
                )
                (setq textfont (strcat textfont text))
            )
        )
        (setq textfont (strcat textfont text))
    )
  )
  
  ;;绘制页眉页脚 PageSetUp vla对象 pt 表格基点 Flag = t 页眉 = nil 页脚
  (defun drawpagesetup ( pagesetup pt flag / getfontstr  leftheader  centerheader
                                             rightheader d          textpt
                                             leftfooter centerfooter rightfooter
                       )
; PageSetup:特性值:
;   AlignMarginsHeaderFooter = 0
;   Application (RO) = #<VLA-OBJECT _Application 0cdd3e9c>
;   BlackAndWhite = 0
;   BottomMargin = 70.8661
;   CenterFooter = "&\"幼圆,加粗\"&16页脚中&N第&P页"
;   CenterFooterPicture (RO) = #<VLA-OBJECT Graphic 1821ca84>
;   CenterHeader = "页眉中"
;   CenterHeaderPicture (RO) = #<VLA-OBJECT Graphic 1821d5c4>
;   CenterHorizontally = 0
;   CenterVertically = 0
;   Creator (RO) = 1480803660
;   DifferentFirstPageHeaderFooter = 0
;   Draft = 0
;   EvenPage (RO) = #<VLA-OBJECT Page 1821c454>
;   FirstPage (RO) = #<VLA-OBJECT Page 1821ddec>
;   FirstPageNumber = -4105
;   FitToPagesTall = 1
;   FitToPagesWide = 1
;   FooterMargin = 36.8504
;   HeaderMargin = 36.8504
;   LeftFooter = "&\"楷体,常规\"&14页&\"楷体,加粗 倾斜\"脚&\"楷体,常规\"左"
;   LeftFooterPicture (RO) = #<VLA-OBJECT Graphic 1821df54>
;   LeftHeader = "页眉左"
;   LeftHeaderPicture (RO) = #<VLA-OBJECT Graphic 1821c724>
;   LeftMargin = 53.8583
;   OddAndEvenPagesHeaderFooter = 0
;   Order = 1.0
;   Orientation = 1.0
;   Pages (RO) = #<VLA-OBJECT Pages 1821c0ac>
;   PaperSize = 9.0
;   Parent (RO) = #<VLA-OBJECT _Worksheet 1821dad4>
;   PrintArea = "$A$1:$N$105"
;   PrintComments = -4142
;   PrintErrors = 0
;   PrintGridlines = 0
;   PrintHeadings = 0
;   PrintNotes = 0
;   PrintQuality = ...不显示带索引的内容...
;   PrintTitleColumns = ""
;   PrintTitleRows = "$1:$3"
;   RightFooter = "&\"楷体,加粗\"&KFF0000页脚右"
;   RightFooterPicture (RO) = #<VLA-OBJECT Graphic 1821dccc>
;   RightHeader = "页眉右"
;   RightHeaderPicture (RO) = #<VLA-OBJECT Graphic 1821c8d4>
;   RightMargin = 53.8583
;   ScaleWithDocHeaderFooter = -1
;   TopMargin = 70.8661
;   Zoom = 100
    (defun GetFontstr (str / size fontname fontstr color)
      ;;用正则表达式删除格式文字
      ;;"&\"幼圆,加粗\"&16页脚&\"楷体,加粗倾斜\"&12&KFFFF00中共&\"幼圆,加粗\"&16&K000000&N页 第&P页"
      (setq fontname (gxl-RegExSearch str "\&\\\".+?\"" "im"))
      (if fontname
          (progn
            (setq fontname (caddar fontname)
                  fontname (gxl-RegExRePlace fontname "" "&\\\"|\\\"" "mg")
                  fontname (mai_str2lst2 fontname ",")
                  fontstr (strcat "{\\f" (car fontname) "|b0|i0|c134|p0;")
            )
            (if (cadr fontname)
                (progn
                    (if (wcmatch (cadr fontname) "*加粗*") 
                        (setq fontstr (strcat fontstr "\\W1.2;"))
                    )
                    (if (wcmatch (cadr fontname) "*倾斜*") 
                        (setq fontstr (strcat fontstr "\\Q18;"))
                    )
                )
            )
          )
          (setq fontstr (strcat "{\\f" standardFont "|b0|i0|c134|p0;" "\\H" (rtos StandardFontSize 2 1) "x;"))
      )
      (setq size (gxl-RegExSearch str "&\\d{1,2}" "im"))
      (if size
          (setq size (caddar size)
                size (gxl-RegExRePlace size "" "&" "mg")
                fontstr (strcat fontstr "\\H" size "x;")
          )
      )
      (if *AnnoColor*
          (if (setq color (gxl-RegExSearch str "\&K[A-Za-z0-9]{6}" "im"))
              (setq color (strcat "#" (substr (caddar color) 3))
                    color (gxl-Hex->ACI color)
                    fontstr (strcat fontstr "\\C" (itoa color) ";")
              )
          )
          (setq fontstr (strcat fontstr "\\C" (itoa *defaultColor*) ";"))
      )
      (setq str (gxl-RegExRePlace str "" "&\\d{1,2}|\&\\\".+?\"|\&K[A-Za-z0-9]{6}" "mg")
            str (gxl-RegExRePlace str (itoa TotalPage) "&N" "mg")
            str (gxl-RegExRePlace str (itoa Page) "&P" "mg")
      )
      (strcat fontstr str "}")
    )
    
    
    
    
    (cond
       (flag ;_ 页眉
         (setq leftheader (vlax-get-property pagesetup 'leftheader)
               centerheader (vlax-get-property pagesetup 'centerheader)
               rightheader (vlax-get-property pagesetup 'rightheader)
         )
         (if (/= "" LeftHeader)
             (progn
                (setq d (* defaultHeight GridScale (vlax-get-property PageSetUp 'HeaderMargin))
                      textpt (mai_point_offset pt 0 d)
                      LeftHeader (GetFontstr LeftHeader)
                )
                (entmake
                   (vl-remove nil
                       (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0) (cons 8 TLayer)
                             (cons 62 *defaultColor*) '(100 . "AcDbMText") (cons 10 (trans textpt 1 0))
                             (cons 40 defaultHeight) (cons 41 (* 0.333 totalwide GridScale defaultHeight))
                             (cons 71 4) (cons 72 5) (cons 1 LeftHeader) (cons 7 "Standard")
                            '(210 0.0 0.0 1.0) '(11 1.0 0.0 0.0) '(50 . 0.0) '(73 . 1)
                       )
                   )
                )
             )
         )
         (if (/= "" CenterHeader)
             (progn
                (setq d (* defaultHeight GridScale (vlax-get-property PageSetUp 'HeaderMargin))
                      textpt (mai_point_offset pt (* 0.5 totalwide GridScale defaultHeight) d)
                      CenterHeader (GetFontstr CenterHeader)
                )
                (entmake
                    (vl-remove nil
                       (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0) (cons 8 TLayer)
                             (cons 62 *defaultColor*) '(100 . "AcDbMText") (cons 10 (trans textpt 1 0))
                             (cons 40 defaultHeight) (cons 41 (* 0.333 totalwide GridScale defaultHeight))
                             (cons 71 5) (cons 72 5) (cons 1 CenterHeader) (cons 7 "Standard")
                             '(210 0.0 0.0 1.0) '(11 1.0 0.0 0.0) '(50 . 0.0) '(73 . 1)
                       )
                    )
                )
             )
         )
         (if (/= "" RightHeader)
             (progn
                (setq d (* defaultHeight GridScale (vlax-get-property PageSetUp 'HeaderMargin))
                      textpt (mai_point_offset pt (* totalwide GridScale defaultHeight) d)
                      RightHeader (GetFontstr RightHeader)
                )
                (entmake
                    (vl-remove nil
                        (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0) (cons 8 TLayer)
                               (cons 62 *defaultColor*) '(100 . "AcDbMText") (cons 10 (trans textpt 1 0))
                               (cons 40 defaultHeight) (cons 41 (* 0.333 totalwide GridScale defaultHeight))
                               (cons 71 6) (cons 72 5) (cons 1 RightHeader) (cons 7 "Standard")
                               '(210 0.0 0.0 1.0) '(11 1.0 0.0 0.0) '(50 . 0.0) '(73 . 1)
                        )
                    )
                )
             )
         )
      )
      (t ;_ 页脚
       (setq leftfooter (vlax-get-property pagesetup 'leftfooter)
             centerfooter (vlax-get-property pagesetup 'centerfooter)
             rightfooter (vlax-get-property pagesetup 'rightfooter)
             d (* defaultheight gridscale (vlax-get-property pagesetup 'footermargin))
       )
       (if (/= "" LeftFooter)
           (progn
                (setq textpt (mai_point_offset pt 0 (- d))
                      LeftFooter (GetFontstr LeftFooter)
                )
                (entmake
                    (vl-remove nil
                        (list (cons 0 "MTEXT") '(100 . "AcDbEntity") '(67 . 0) (cons 8 TLayer)
                              (cons 62 *defaultColor*) '(100 . "AcDbMText") (cons 10 (trans textpt 1 0))
                              (cons 40 defaultHeight) (cons 41 (* 0.333 totalwide GridScale defaultHeight))
                              (cons 71 4) (cons 72 5) (cons 1 LeftFooter) (cons 7 "Standard")
                              '(210 0.0 0.0 1.0) '(11 1.0 0.0 0.0) '(50 . 0.0) '(73 . 1)
                        )
                    )
                )
            )
        )
        (if (/= "" CenterFooter)
            (progn
                (setq textpt (mai_point_offset pt (* 0.5 totalwide GridScale defaultHeight) (- d))
                      CenterFooter (GetFontstr CenterFooter)
                )
                (entmake
                    (vl-remove nil
                        (list (cons 0 "MTEXT") '(100 . "AcDbEntity") '(67 . 0) (cons 8 TLayer)
                              (cons 62 *defaultColor*) '(100 . "AcDbMText") (cons 10 (trans textpt 1 0))
                              (cons 40 defaultHeight) (cons 41 (* 0.333 totalwide GridScale defaultHeight))
                              (cons 71 5) (cons 72 5) (cons 1 CenterFooter) (cons 7 "Standard")
                              '(210 0.0 0.0 1.0) '(11 1.0 0.0 0.0) '(50 . 0.0) '(73 . 1)
                        )
                    )
                )
            )
        )
        (if (/= "" RightFooter)
            (progn
                (setq textpt (mai_point_offset pt (* totalwide GridScale defaultHeight) (- d))
                      RightFooter (GetFontstr RightFooter)
                )
                (entmake
                    (vl-remove nil
                        (list (cons 0 "MTEXT") '(100 . "AcDbEntity") '(67 . 0) (cons 8 TLayer)
                              (cons 62 *defaultColor*) '(100 . "AcDbMText") (cons 10 (trans textpt 1 0))
                              (cons 40 defaultHeight) (cons 41 (* 0.333 totalwide GridScale defaultHeight))
                              (cons 71 6) (cons 72 5) (cons 1 RightFooter) (cons 7 "Standard")
                              '(210 0.0 0.0 1.0) '(11 1.0 0.0 0.0) '(50 . 0.0) '(73 . 1)
                        )
                    )
                )
            )
        )
       
       )
    )
  )
  
  
;;主程序开始
  (mini_start nil)
  (setq Layers (mai_tblsearch "layer")
        tmp_dcl (mkTmpDcl)
        old_dcl_load (load_dialog tmp_dcl)
  )
  (new_dialog "xl2cad" old_dcl_load)
  (start_xl2x)
  (setq ecode (start_dialog))
  (vl-file-delete tmp_dcl)
  (cond
    ((= 1 ecode)
     (if *cellcolor* (setvar "regenmode" 0))
     (mai_cell_app_init)
     (or *xlapp* (setq *xlapp* (vl-catch-all-apply 'vlax-get-or-create-object '("Excel.Application"))))
     (if (vl-catch-all-error-p *xlapp*) (exit))
     (if (equal :vlax-false (vlax-get-property *xlapp* 'visible))
         (vlax-put-property *xlApp* 'visible :vlax-true)
     )
     (if (= "User" *DrawRange*)
         (vlax-put-property *XLAPP* 'Visible :vlax-true)
     )
     (setq workbooks (vlax-get-property *xlApp* 'workbooks)
           workbook (if (= 0 (vlax-get-property workbooks 'Count))
                        (vlax-invoke workbooks 'add)
                        (vlax-get-property *xlApp* 'activeworkbook)
                    )
           sheet (vlax-get-property *xlApp* 'activesheet)
           UsedRange (vlax-get-property sheet 'UsedRange)
           col (vlax-get-property (vlax-get-property UsedRange 'columns) 'count)
           row (vlax-get-property (vlax-get-property UsedRange 'rows) 'count)
     )
     (cond
       ((= "Used" *DrawRange*)
        (setq Cells (vlax-get-property UsedRange 'Cells))
        ;(setq PrintArea (VLXLS-GET-PROPERTY *xlApp* "Activesheet.PageSetup.PrintArea"))
       )
       ((= "User" *DrawRange*)
        (alert "请在表格中选择数据后按确定键！")
        (setq Selection (vlax-get-property *xlApp* 'Selection)
              Cells (vlax-get-property Selection 'Cells)
        )
        ;(setq PrintArea (VLXLS-GET-PROPERTY *xlApp* "Activesheet.PageSetup.PrintArea"))
       )
       ((= "PrintArea" *DrawRange*)
        (setq printarea (vlxls-get-property *xlapp* "Activesheet.PageSetup.PrintArea"))
        (if (= "" printarea)
            (progn
               (alert "当前活动表格没有可打印的页面！\n\n请重新设置页面！程序将退出！")
               (exit)
            )
            (setq cells (vlax-get-property (vlax-get-property *xlapp* 'range printarea) 'cells))
        )
       )
     )
     (if (= 1 (vlax-get-property cells 'count))
         (progn
             (alert "Excel表格只有一行一列，程序将退出！")
             (exit)
         )
     )
     (if *pageSetUp*
         (progn
            (setq hpagebreaks nil)
            (gxl-catchapply
                  (lambda ()
                     (vlax-for a (vlxls-get-property *xlapp* "activesheet.HPageBreaks")
                         (setq hpagebreaks (cons (vlxls-get-property a "Location.row") HPageBreaks))
                     )
                  )
                  nil
            )
            (setq HPageBreaks (reverse HPageBreaks)) ;_ 储存分页的Row位置
         )
     )
  (initget 7)
  (or (setq StartPoint (getpoint "\n放置位置:")) (exit))
  (setq BasePoint StartPoint
        curpt  StartPoint
        OldRow nil
        dxf71data '((1 4 7) (2 5 8) (3 6 9))
    ;|71 
     附着点：
    1 = 左上；2 = 中上；3 = 右上
    4 = 左中；5 = 正中；6 = 右中
    7 = 左下；8 = 中下；9 = 右下 
   ;|;
        StandardFont (vlax-get-property *xlApp* 'StandardFont)
        StandardFontSize (vlax-get-property *XLAPP* 'StandardFontSize)
        defaultHeight (/ *THeight* StandardFontSize) ;_ 默认高度
        GridScale 1.941747572815534
        totalwide (vlax-variant-value (vlax-get-property cells 'Width))
        totalheight (vlax-variant-value (vlax-get-property cells 'height))
        pagesetup (VLXLS-GET-PROPERTY *xlapp* "activesheet.pagesetup")
  )
  ;(setvar "clayer" Blayer)
  ;(setvar "cecolor" *defaultColor*)
  (if (not *KeepTHeight*)
      (progn      
        (setq p0 (mai_point_offset StartPoint (* totalwide GridScale defaultHeight) (* -1. totalheight GridScale defaultHeight))
              endent (mai_entmake "rectang" (list StartPoint p0))
        )
        (setvar 'ORTHOMODE 1)
        (initget 6)
        (setq scale (* totalwide GridScale defaultHeight)
              p0 (getdist StartPoint (strcat "\n输入表格宽度:<" (rtos scale 2 2) ">"))
        )
        (or p0 (setq p0 scale))
        (entdel endent)
        (setq scale (/ p0 scale)
              defaultHeight (* defaultHeight scale)
        )  
     )
  )
  (setq endent (entlast)
        page 1
        TotalPage (1+ (length HPageBreaks))
  )
  (if *pageSetUp*
      (progn
        (setq PageMargin  ;_ 计算页间距
                (* defaultHeight GridScale
                   (+ (vlxls-get-property *xlapp* "activesheet.pagesetup.BottomMargin")
                      (vlxls-get-property *xlapp* "activesheet.pagesetup.FooterMargin")
                      (vlxls-get-property *xlapp* "activesheet.pagesetup.TopMargin")
                      (vlxls-get-property *xlapp* "activesheet.pagesetup.HeaderMargin")
                   )
                )
              RightTopPt (mai_point_offset StartPoint (* defaultHeight GridScale Totalwide) 0)
        ) ;_ 每页右上角点
        ;;输出页眉
        (drawpagesetup pagesetup startpoint t)
         ;;输出表头
        (printtitlerows cells)
      )
  )
  (if (setq titlerows (vlxls-get-property *xlapp* "ActiveSheet.PageSetup.PrintTitleRows"))  ;_ 存储表头的行数
      (progn
        (setq titlerows (mapcar 'atoi (vl-remove "" (gxl-strparsebylst titleRows '(":" "$"))))
              tmp (car titlerows)
              tmp1 (cadr titlerows)
              titlerows nil
        )
        (if tmp1
            (while (<= tmp tmp1)
                (setq titlerows (cons tmp titlerows)
                      tmp (1+ tmp)
                )
            )
            (setq titlerows (list tmp))
        )
        (setq titlerows (reverse titlerows))
      )
  )

    
  
   ;;逐行逐列绘制表格
  (vlax-for cell cells
    (setq col (vlax-get-property cell 'column)
          row (vlax-get-property cell 'row)
          range (msxlp-get-range *xlapp* (vlxls-rangeid (list col row)))
          mergep (equal :vlax-true (vlax-variant-value (vlax-get-property cell 'mergecells)))
          height (* defaultheight gridscale)
          width (* height (vlax-variant-value (vlax-get-property cell 'width)))
          height (* height (vlax-variant-value (vlax-get-property cell 'height)))
          text (vlax-variant-value (vlax-get-property cell 'text))
    )
    (cond
      ((and *pageSetUp* (member row TitleRows))) ;_ 忽略打印表头位置的表格
      (t
       (and (/= text "")
            (not (equal width 0 0.01))
            (progn
              (setq font (vlax-get-property range 'font)
                    dxf71 (vlax-variant-value (vlax-get-property Cell 'HorizontalAlignment))
                    HorizontalAlignment (cond ((= dxf71 -4152) 2) ;_ 右
                                              ((= dxf71 -4108) 1) ;_ 中
                                              (0) ;_ 左
                                        )
                    dxf71 (vlax-variant-value (vlax-get-property Cell 'VerticalAlignment))
                    VerticalAlignment (cond ((= dxf71 -4160) 0) ;_ 上
                                            ((= dxf71 -4108) 1) ;_ 中
                                            (2) ;_ 下
                                      )
                    dxf71 (nth verticalalignment (nth horizontalalignment dxf71data))
                    DXF62 (vlxls-color-eci->aci (vlax-variant-value (vlax-get-property Font 'colorIndex)))
                    DXF420 (vlxls-color-eci->truecolor (vlax-variant-value (vlax-get-property Font 'colorIndex)))
              ;;计算Range的字体 RangeFont i ii char cfont charFont caption f TextVerFlag
                    RangeFont
                        (mapcar '(lambda (x) (cons x (vlxls-get-property font x)))
                                '("name" "size" "colorindex" "bold" "italic" "subscript" "superscript" "underline")
                        )
                    dxf7 (mai_dxf "NAME" RangeFont)
              )
              (or dxf7 (setq DXF7 StandardFont))
              ;;字体
              (setq textFont (strcat "{\\f" dxf7 "|b0|i0|c134|p0;")
                    dxf40 (cdr (assoc "SIZE" RangeFont))
              )
              (or dxf40 (setq dxf40 standardfontsize))
              ;;字大小
              (setq textFont (strcat textFont "\\H" (rtos dxf40 2 1) "x;"))
              ;;加粗
              (if (equal :vlax-true (mai_dxf "BOLD" RangeFont))
                  (setq textfont (strcat textFont "\\W1.2;"))
              )
              ;;倾斜
              (if (equal :vlax-true (mai_dxf "ITALIC" RangeFont))
                  (setq textfont (strcat textFont "\\Q18;"))
              )
              ;;下划线
              (if (= 2 (mai_dxf "UNDERLINE" RangeFont))
                  (setq textfont (strcat textFont "\\L"))
              )
              ;;上标 "SUPERSCRIPT"
              ;;下标 "SUBSCRIPT"
              ;;文字是否竖向
              (setq textverflag (= (gxl-catchapply vlxls-get-property (list range "orientation")) -4166))
              (if TextVerFlag
                  (setq text (mai_lst2str (mai_str2lst text "") "\\P"))
              )
              ;;逐字取样式
              ;;(setq textFont (strcat textFont (GetRangeTextStyle RANGE RANGEFONT text) "}"))
    
              (setq text (strcat textFont text "}"))

            )
       )
       (cond ((null OldRow) (setq OldRow Row))
             ((/= OldRow Row) ;_ 换行
              (if (and *pageSetUp*
                       (member row HPageBreaks) ;_ 换页
                  )
                  (progn
                        (setq OldRow Row
                              StartPoint (mai_point_offset StartPoint 0 (- oldheight))
                        )
                        (if *Merge*
                            (progn
                                (setq p0 (mai_point_offset StartPoint (* defaultHeight GridScale Totalwide) 0))
                                (mai_entmake "line" (list StartPoint p0))
                                (mai_entmake "line" (list RightTopPt p0))
                            )
                        )
                        ;;输出页脚代吗
                        (if *pageSetUp* (DrawPageSetUp pagesetup StartPoint nil))
                        ;;分组或分块
                        (setq ss (mai_newset endent))
                        (if *CellColor*
                            (progn
                                (command "_select" ss "")
                                (setq s1 (ssget "_p" '((0 . "solid"))))
                                (if s1 (gxl-MovetoBottom s1))
                            )
                        )
                        (cond ((= 1 *Oprate*) (gxl-AX:AddUnNameGroup ss))
                              ((= 2 *Oprate*) (gxl-BLK-UnBlockBase ss 4))
                        )
                        (setq endent (entlast)
                              StartPoint (mai_point_offset StartPoint 0 (- PageMargin))
                              Curpt StartPoint
                              RightTopPt (mai_point_offset StartPoint (* defaultHeight GridScale Totalwide) 0)
                              ;_ 移动页间距
                              page (1+ page)
                        )
                            ;;输出页眉代吗
                        (if *pageSetUp* (DrawPageSetUp pagesetup StartPoint t))
                        ;;输出表头
                        (if *pageSetUp* (PrintTitleRows cells))
           
                  )
                  (setq OldRow Row
                        StartPoint (mai_point_offset StartPoint 0 (- oldheight))
                        Curpt StartPoint
                  )
             )
            )
        )
    
        (setq oldheight height)
        (if (not (equal width 0 0.01))
            (progn
                (if Mergep
                    (setq mergeId (mapcar 'vlxls-rangeid (vlxls-cellid (vlxls-range-getid range)))
                          width1 (* defaultheight gridscale (vlxls-get-property range "mergearea.width"))
                          height1 (* defaultheight gridscale (vlxls-get-property range "mergearea.height"))
                    )
                    (setq width1 width height1 height)
                )
                (if (or (not Mergep)
                        (equal (car mergeId) (list col row))
                    )
                    (progn
                        (setq p0 (mai_point_offset Curpt 0 (- height1))
                              p1 Curpt
                              p2 (mai_point_offset Curpt width1 0)
                              p3 (mai_point_offset p2  0 (- height1))
                        ) ;_ 框的四个角点 左下、左上、右上、右下
                        (if *Merge*
                            (progn
                                (and Horline
                                     (equal p1 (mai_dxf 11 HorLine) 1e-3)
                                     (gxl-ch_ent HorLine 11 p2) ;_ 更新水平直线末端点
                                )
                                (setq Horline (mai_entmake "line" (list p1 p2)))
                                (or (and VerLines
                                         (vl-some '(lambda(x)(if (equal p1 (mai_dxf 11 x) 1e-3) (gxl-ch_ent x 11 p0))) verlines) ;_ 更新垂直直线末端点
                                    )
                                    (setq VerLines (cons (mai_entmake "line" (list p1 p0)) VerLines))
                                )
                            )
                            (mai_entmake "LWPOLYLINE" (list p0 p1 p2 p3 p0))
                        )
                        (and *CellColor* ;_ 绘制背景颜色
                             (/= -4142 (setq interiorcolor (vlxls-get-property range "interior.colorindex")))
                             (progn
                                (setq interiorcolor (vlxls-color-eci->aci interiorcolor)
                                      interiortruecolor (vlxls-color-eci->truecolor interiorcolor)
                                )
                                (setvar "cecolor" Interiorcolor)
                                (mai_entmake "SOLID" (list p0 p1 p2 p3))
                            )
                        )
                        (if (/= "" text)
                            (progn
                                (setq textpt (nth (1- dxf71) (get9justpts p0 p2)))
                                (cond ((= 0 HorizontalAlignment) ;_ 左对齐
                                       (setq textpt (mai_point_offset textpt (* height 0.1) 0))
                                      )
                                      ((= 2 HorizontalAlignment) ;_ 右对齐
                                       (setq textpt (mai_point_offset textpt (* height -0.1) 0))
                                      )
                                )
                                (cond ((= 0 VerticalAlignment) ;_ 上对齐
                                       (setq textpt (mai_point_offset textpt 0 (* height -0.1)))
                                      )
                                      ((= 2 VerticalAlignment) ;_ 下对齐
                                       (setq textpt (mai_point_offset textpt 0 (* height 0.1)))
                                      )
                                )
                                (entmake
                                    (vl-remove nil
                                        (list (cons 0 "MTEXT") '(100 . "AcDbEntity") '(67 . 0) (cons 8 TLayer)
                                              (cons 62 (if *AnnoColor* dxf62 *defaultColor*)) '(100 . "AcDbMText")
                                              (cons 10 (trans textpt 1 0)) (cons 40 defaultHeight) (cons 41 width1)
                                              (cons 71 DXF71) (cons 72 5) (cons 1 text) (cons 7 "Standard")
                                              '(210 0.0 0.0 1.0) '(11 1.0 0.0 0.0) '(50 . 0.0) '(73 . 1)
                                        )
                                    )
                                )
                            )
                        )
                    )
                )
                (setq Curpt (polar Curpt 0 width))
            )
        )
       ) ;_ t
    ) ;_ cond
  )
  
 (if *Merge*
    (progn
        (setq dd (if *pagesetup* (* pagemargin (length hpagebreaks)) 0)
              p0 (if *pagesetup* righttoppt (mai_point_offset basepoint (* defaultheight gridscale totalwide) 0))
        )
        (setvar "cecolor" *defaultColor*)
        (mai_entmake "line" (list p0 p3 (mai_point_offset p3 (* -1. defaultHeight GridScale Totalwide) 0)))
        (setq p3 (mai_point_offset p2 0 (- height1)))
    )
 )
 ;;输出页脚代吗
 (if *pageSetUp* (DrawPageSetUp pagesetup StartPoint nil))
 (setq ss (mai_newset endent))
 (if *CellColor*
     (progn
         (command "_select" ss "")
         (setq s1 (ssget "_p" '((0 . "solid"))))
         (if s1 (gxl-MovetoBottom s1))
     )
 )
 (cond ((= 1 *oprate*) (gxl-ax:addunnamegroup ss))
       ((= 2 *oprate*) (gxl-blk-unblockbase ss 4))
 )
 (vlax-release-object *xlapp*)
)
)
(mai_end)
)



(princ "\nExcel表格->CAD表格 By Gu_xl 命令: Gu_X2C ")
(princ "\n*** Gu_xl@sohu.com 2013.06.09 ***") 
(princ)
