函数二

zynyjp

;;137.1 [功能] 获得图形中倒数第二个图元的函数
(defun MJ:EntSecLast (/ e sle)
  (entdel (setq e (entlast)))
  (setq sle (entlast))
  (entdel e)
  sle
)
;;137.2 [功能] 图中最后图元Find True last entity
(Defun MJ:LASTENT (/ E0 EN)
  (Setq E0 (EntLast))
  (While (Setq EN (EntNext E0)) (Setq E0 EN))
  E0
)
;; [功能] 遍历选择集对所包含的图元进行指定函数操作
;; [参数] SS----选择集
;;        FUN---函数名
;; [返回] 最后一个图元的操作结果
(defun MJ:SS-FOR (SS FUN / N)
  (repeat (setq N (sslength SS))
    (apply FUN (list (ssname SS (setq N (1- N)))))
  )
)
;;85.6 [功能] 字符串函数   by qjchen@gmail.com
;;str是准备被处理的字符串，delim是一个字符串集合，其中的每一个字符都会被当作是分割符号
;;如 (MJ:delim "25 35 45 ; 55, 66 " " ;")=> ("25" "35" "45" "55," "66")
;;(MJ:delim "aa 10 b10x20.2" "")返回("aa 10 b10x20.2")
(defun MJ:delim (str delim / l1 l2)
  (setq str (vl-string->list str) delim (vl-string->list delim))
  (while str
    (if (not (member (car str) delim))
             (setq l1 (cons (car str) l1))
             (if l1 (setq l2 (cons (vl-list->string (reverse l1)) l2) l1 nil))
    )
    (setq str (cdr str))
  )
  (if l1 (setq l2 (cons (vl-list->string (reverse l1)) l2)))
  (reverse l2)
)

;;;特殊数据表的对比函数
(defun compare_list (list1 list2 need_length / value_list1 value_list2 answer
      )
     ;;参数说明，list1，list2为两个需要比较的子项， need_length 为需要比较的字符串最后一项比较值位置
     (while (> need_length 0)
   (setq value_list1 (ATOI (nth need_length list1)))
   (setq value_list2 (ATOI (nth need_length list2)))
   (if (= value_list1 value_list2)
        (if (> need_length 3)
      ;;当不是最后一组比较数据时，准备比较下一组数据
      (setq need_length (- need_length 2))
      (progn (setq need_length 0)
      ;;(> need_length 3) 说明目前已经比较的是最后一组数据了
      (setq answer 1)
      ;;表示表数据相同
      )
        )
        (progn (setq need_length 0)
         ;表示当前组的比较结果不相同，则整个表数据就不相同，退出继续比较
        (setq answer 0)
        ;;表示表数据不同
        )
   )
     )
         ; (princ answer)
)
(defun sjhs();;;随机数函数
(setq dat (rtos (- (* (getvar "cdate") 1000000000000) 2e+19) 2 16))
(setq strl (strlen dat))
(setq mins (atoi (substr dat (- strl 5) 2)))
(if (= mins 0) (setq mins 0.5))
(setq sec (atoi (substr dat (- strl 3) 2)))
(if (= sec 0) (setq sec 0.5))
(setq sec1 (atoi (substr dat (- strl 1))))
(if (= sec1 0) (setq sec1 0.5)(setq sec1 sec1))
(setq num1 (/ (+ pi (* sec1 mins)) sec))
(if (< num1 0.1) (setq num (* num1 10)))
(if (and (> num1 0.1) (< num1 1)) (setq num num1))
(if (and (> num1 1) (< num1 10)) (setq num (/ num1 10.0)))
(if (and (> num1 10) (< num1 100)) (setq num (/ num1 100.0)))
(if (and (> num1 100) (< num1 1000)) (setq num (/ num1 1000.0)))
(if (and (> num1 1000) (< num1 10000)) (setq num (/ num1 10000.0)))
(setq num (/ (atoi (rtos (* num 1000) 2 0)) 1000.0))
)
;;;;;;;;此为经整理过后一些VLISP调用EXCEL常用公共函数;;;;;;;;;;;;
;;;;;;;;此为私人函数未经许可请勿...............................
;;;;;;;;开发:朱卫星 2005/02/22 rev01............................
;;;;;;;;it's the first!ok!used in acad at least rev. 2000;;;;;;;
(Defun vlxls-variant->list (VarX / Run Item Rtn)
  (setq Run T)
  (while Run
    (cond ((= (type VarX) 'SAFEARRAY)
    (setq VarX (vlax-safearray->list VarX)))
    ((= (type VarX) '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))
     )
      )
    )
      ((= VarX nil) (setq Rtn ""))
      (t (setq Rtn VarX)))
  Rtn)

(Defun vlxls-color-ECI->truecolor (Color / Rtn)
  (if (setq Rtn (cdr (assoc Color *xls-color*)))
  (setq Rtn (nth 1 Rtn)))
  (if (null Rtn)
  (setq Rtn 16711935)
  )Rtn
  )
;;;EXAMPLE:
;;;(vlxls-color-eci->truecolor 0)return: 16711935
;;;(vlxls-color-eci->truecolor 1)return: 0
;;;(vlxls-color-eci->truecolor 12)return: 8355584
;;;(vlxls-color-eci->truecolor 120)return: 16711935

(Defun vlxls-color-eci->aci (Color / Rtn)
(if (null (setq Rtn (cdr (assoc Color *xls-color*))))
(setq Rtn 256)
(setq Rtn (nth 0 Rtn))
)
Rtn)
;;;EXAMPLE:
;;;(vlxls-color-eci->aci 0)return: 256
;;;(vlxls-color-eci->aci 1)return: 18
;;;(vlxls-color-eci->aci 12)return: 56
;;;(vlxls-color-eci->aci 120)return: 256

(Defun vlxls-color-aci->eci (Color / Item Rtn)
  (foreach Item    *xls-color*
    (if    (= (nth 1 Item) Color)
    (setq Rtn (car Item)))
   )
  (if (null Rtn)
  (setq Rtn 0))
  Rtn
  )
;;;Examples:
;;;(vlxls-color-aci->eci 0)return: 0
;;;(vlxls-color-aci->eci 1)return: 3
;;;(vlxls-color-aci->eci 12)return: 0
;;;(vlxls-color-aci->eci 120)return: 0
(Defun vlxls-color-aci->truecolor (aci)
(vlxls-color-eci->truecolor (vlxls-color-aci->eci aci))
  )
;;;Examples:
;;;(vlxls-color-aci-> truecolor 0) return: 16711935
;;;(vlxls-color-aci->truecolor 1)  return: 16711680
;;;(vlxls-color-aci-> truecolor 12)return: 16711935
;;;(vlxls-color-aci-> truecolor 120)return: 16711935
;;;OK!NOW LET'S GO! START EXCEL.APPLICATION!!............
;;;before use these program you should install "Microsoft Excel" in your computer!!
;;;if not,you will recicieve an error messege!!
;;;such as "warning:........."! ZWX 2005/02/22 COPYRIGHT .....
(Defun vlxls-app-Init (/ OSVar GGG Olb8 Olb9 Olb10 TLB Out msg msg1 msg2)
  ;;;;;;;;;;该程序实现了初始化EXCEL应用程序!
  (if *Chinese*
  (setq msg  "\n 初始化微软Excel "
        msg1 "\042初始化Excel失败\042"
        msg2 (strcat "\042 警告""\n ====""\n 无法在您的计算机上检测到微软Excel软件"
              "\n 如果您确认已经安装Excel, 请发送电子邮"
       "\n 件到yota@ikozmos.com获取更多的解决方案\042"))
  (setq msg  "\n Initializing Microsoft Excel "
        msg1 "\042Initialization Error\042"
msg2 (strcat "\042 WARNING""\n ======="
                     "\n Can NOT detect Excel97/200X/XP in your computer"
       "\n If you already have Excel installed, please email"
       "\n us to get more solution via yota@ikozmos.com\042"))
    )
(if (null msxl-xl24HourClock)
(progn (if (and (setq GGG (vl-registry-read
"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\Excel.EXE"
"Path"))
(setq GGG (strcase (strcat GGG "Excel.EXE"))))
(progn (foreach OSVar (list "SYSTEMROOT" "WINDIR""WINBOOTDIR" "SYSTEMDRIVE"
           "USERNAME"  "COMPUTERNAME" "HOMEDRIVE" "HOMEPATH" "PROGRAMFILES")
   (if    (vl-string-search (strcat "%" OSVar "%") GGG)
          (setq GGG (vl-string-subst (strcase (getenv OSVar))
        (strcat "%" OSVar "%")GGG)))
  )
(setq   Olb8  (findfile (vl-string-subst "EXCEL8.OLB" "EXCEL.EXE" GGG))
         Olb9  (findfile (vl-string-subst "EXCEL9.OLB" "EXCEL.EXE" GGG))
         Olb10 (findfile (vl-string-subst "EXCEL10.OLB" "EXCEL.EXE" GGG)))
(cond  ((= (vl-filename-base (vl-filename-directory GGG))"OFFICE11")
  (setq TLB GGG Out "2003"))
((= (vl-filename-base (vl-filename-directory GGG))
     "OFFICE10")
  (setq TLB GGG Out "XP"))
         (Olb9 (setq TLB Olb9 Out "2000"))
  (Olb8 (setq TLB Olb8 Out "97"))
         (t (setq Out "Version Unknown"))
)
  (if TLB (progn (princ (strcat MSG Out "..."))
                 (vlax-import-type-library
                    :tlb-filename TLB
      :methods-prefix "msxl-"
      :properties-prefix "msxl-"
      :constants-prefix "msxl-"))
    )
  )(progn (if vldcl-msgbox
             (vldcl-msgbox "x" msg1 msg2)
      (alert (read msg2)))
          (exit)))
  )
  )
  msxl-xl24HourClock
  )
;;;Examples:
;;;(vlxls-app-init) return: 33
(Defun vlxls-app-New (UnHide / Rtn)
  ;;;; 该程序实现功能:新建一个excel格
  ;;;;;;;;;; THIS PROGRAM CAN BUILD A NEW EXCELFILE
  (if (vlxls-app-init)
      (progn
      (if *Chinese* (princ "\n 新建微软Excel工作表...")
                    (princ "\n Creating new Excel Spreadsheet file..."))
      (if (setq Rtn (vlax-get-or-create-object "Excel.Application"))
      (progn (vlax-invoke-method
             (vlax-get-property Rtn 'WorkBooks)
      'Add)
(if UnHide (vla-put-visible Rtn 1)
   (vla-put-visible Rtn 0))
    )
    )
      )
    )
  Rtn
  )
;;;Examples:
;;;(setq *xlapp* (vlxls-app-new T)) return: #
(Defun vlxls-app-open(XLSFile UnHide / ExcelApp WorkSheet Sheets ActiveSheet Rtn)
  ;;;function: this program can open an excelfile
  (setq XLSFile (strcase XLSFile))
  (if (null (wcmatch XLSFile "*.XLS"))
  (setq XLSFile (strcat XLSFile ".XLS")))
  (if (and (findfile XLSFile)
       (setq Rtn (vlax-get-or-create-object "Excel.Application")))
    (progn (vlax-invoke-method (vlax-get-property Rtn 'WorkBooks)
        'Open XLSFile)
(if UnHide
    (vla-put-visible Rtn 1)
    (vla-put-visible Rtn 0))))
  Rtn)
;;;Examples:
;;;(setq *xlapp* (vlxls-app-open "C:/test.XLS" T)) e #
(Defun vlxls-app-save (xlapp)
  ;;;;保存文件
  (equal (vlax-invoke-method
         (vlax-get-property Xlapp "ActiveWorkbook")"Save")
  :vlax-true)
  )
;;;Examples:
;;;(vlxls-app-save *xlapp*) return: T
(Defun vlxls-app-saveas (xlapp Filename / Rtn);;;另存文件
   (if (null filename)
    (setq filename (strcat (getvar "dwgprefix") "XLS.XLS")))
   (if (null (wcmatch (setq filename (strcase Filename)) "*.XLS"))
   (setq filename (strcat filename ".XLS")))
   (if (findfile Filename)
    (vl-file-delete (findfile Filename))
    )
   (vlax-invoke-method
     (vlax-get-property Xlapp "ActiveWorkbook")
     "SaveAs"
     Filename
     msxl-xlNormal
     ""
     ""
     :vlax-False
     :vlax-False
     nil
     )
  (findfile Filename)
  )
;;;Examples:
;;;(vlxls-app-saveas *xlapp* nil) return: "C:/Temp-Folder/XLS.XLS"
;;;(vlxls-app-saveas *xlapp* "C:/Temp-Folder/XLS.XLS") return: "C:/Temp-Folder/XLS.XLS"
;;;(vlxls-app-saveas *xlapp* nil) return: 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
      )
    )
  (vlax-invoke-method ExlObj 'QUIT)
  (vlax-release-object ExlObj)
  (setq ExlObj nil)
  (gc)
  )
;;;Examples:
;;;(vlxls-app-quit *xlapp* nil) return: nil
(Defun vlxls-app-kill (SaveYN / ExlObj);;;强行清除所有EXCEL应用程序
  (while (setq ExlObj (vlax-get-object "Excel.Application"))
    (vlxls-app-quit ExlObj SaveYN))
  )
;;;Examples:
;;;(vlxls-app-kill T) return: nil
(Defun vlxls-app-autofit (xlapp / sh act Rtn);;;存储格自动调整大小
  (setq act (vlxls-Sheet-Get-Active xlapp))
  (foreach sh (append (vl-remove act (vlxls-sheet-get-all Xlapp))
            (list act))
  (setq Rtn (variant-value (msxl-autofit
        (msxl-get-columns
          (msxl-get-Cells
              (vlxls-sheet-get-usedrange xlapp sh))))))
    )
  (equal Rtn :vlax-true)
  )
;;;Examples:
;;;(vlxls-app-autofit *xlapp*) return: T
;;;(vlxls-app-autofit *xlapp*) return: NIL
(Defun vlxls-sheet-get-all (xlapp / SH Rtn);;;;取得所有应用的页
  (vlax-for SH (vlax-get-property Xlapp "sheets")
  (setq Rtn (cons (vlax-get-property sh "Name") Rtn))
  )(reverse Rtn)
  )
;;;Examples:
;;;(vlxls-sheet-get-all *xlapp*) e ("Sheet1" "Sheet2" "Sheet3")
(Defun vlxls-Sheet-Get-Active (xlapp);;;;返回当前应用的页
  (vlax-get-property (msxl-get-ActiveSheet Xlapp) 'name)
  )
;;;Examples:
;;;(vlxls-sheet-get-active *xlapp*) return: "Sheet2"
(Defun vlxls-sheet-delete (xlapp Name / sh Rtn);;;删除页
  (setq Rtn (vlxls-sheet-get-all Xlapp))
  (vlax-for sh (vlax-get-property Xlapp "sheets")
   (if    (= (vlax-get-property sh "Name") Name)
    (vlax-invoke-method sh "Delete"))
    )
  (not (equal Rtn (vlxls-sheet-get-all Xlapp)))
  )
;;;Examples:
;;;(vlxls-sheet-delete *xlapp* "Sheet1") return: T
;;;(vlxls-sheet-delete *xlapp* "UnExistingSheet") return: NIL
(Defun vlxls-sheet-rename (New Old Xlapp / sh Rtn);;;给页重新命名
  (if (null old)
    (setq old (msxl-get-name (msxl-get-activesheet Xlapp))))
  (if (member New (vlxls-sheet-get-all Xlapp))
   (setq Rtn nil)
    (progn (vlax-for sh (vlax-get-property Xlapp "sheets")
          (if (= (msxl-get-name sh) Old)
           (msxl-put-name sh New)))
      (setq Rtn (equal New (vlax-get-property (msxl-get-ActiveSheet Xlapp) 'name)))
      )
    )
  Rtn
  )
;;;Examples:
;;;(vlxls-sheet-rename "New" "Sheet1" *xlapp*) return: T
;;;(vlxls-sheet-rename "New" NIL *xlapp*) return: T
;;;(vlxls-sheet-rename "Sheet3" NIL *xlapp*) return: NIL
;;;(vlxls-sheet-rename "Sheet2" "Sheet1" *xlapp*) return: NIL
;;;(vlxls-sheet-rename "Sheet2" "UnExistSheet" *xlapp*) return: NIL
(Defun vlxls-sheet-add (xlapp Name / Rtn);;;增加页
  (if (member name (vlxls-sheet-get-all xlapp))
      (setq Rtn nil)
   (progn (vlax-put-property
          (vlax-invoke-method
     (vlax-get-property Xlapp "sheets") "Add")
       "name" Name)
(setq Rtn (equal (vlxls-sheet-get-active xlapp) name))
  ))
  Rtn
  )
;;;Examples:
;;;(vlxls-sheet-add *xlapp* "Sheet1") return: T
;;;(vlxls-sheet-add *xlapp* NIL) return: T
;;;(vlxls-sheet-add *xlapp* "NewSheet") return: NIL
(Defun vlxls-sheet-put-active (xlapp Name / sh);;;设置当前使用页
  (if (null (vlxls-sheet-add xlapp name))
    (vlax-for sh    (vlax-get-property Xlapp "sheets")
      (if (= (vlax-get-property sh "Name") Name)
(vlax-invoke-method sh "Activate")
)
      )
    )
  (equal (vlxls-sheet-get-active xlapp) name)
  )
;;;Examples:
;;;(vlxls-sheet-put-active *xlapp* "Sheet1") return: T
;;;(vlxls-sheet-put-active *xlapp* "NewSheet") return: T
(Defun vlxls-sheet-get-UsedRange (xlapp Name / sh Rtn);;;取得使用页的使用范围
  (if (null Name)
     (setq Name (vlax-get-property (msxl-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
  )
;;;Examples:
;;;(vlxls-sheet-get-usedrange *xlapp* "Sheet1") return: T
;;;(vlxls-sheet- get-usedrange *xlapp* "NewSheet") return: T
(Defun vlxls-cellid (id / xx id1 id2 Rtn) ;;;;cell id 转换
  (if (= (type id) 'list)
    (setq id (vlxls-rangeid id))
    )
  (setq id (strcase id))
  (if (null (setq xx (vl-string-search ":" id)))
  (setq Rtn (list id ""))
  (setq id1 (substr id 1 xx)
id2 (substr id (+ xx 2))
id1 (vlxls-rangeid id1)
id2 (vlxls-rangeid id2)
Rtn (list (vlxls-rangeid (list (min (car id1) (car id2))
   (min (cadr id1) (cadr id2))))
    (vlxls-rangeid (list (max (car id1) (car id2))
           (max (cadr id1) (cadr id2)))))
)
    )
  Rtn
  )
;;;Examples:
;;;(vlxls-cellid '(3 14)) return: ("C14" "")
;;;(vlxls-cellid "D23") return: ("D23" "")
;;;(vlxls-cellid "C12:F3") return: ("C3" "F12")
;;;(vlxls-cellid "F15:G22") return: ("F15" "G22")
(Defun vlxls-rangeid (id / str->list list->str xid->str Rtn) ;;;;range id 转换
  (Defun str->list1 (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->str1 (idr / x y)
  (setq x (car idr)
y (cadr idr)
x (xid->str x)
y (itoa y)
)
  (strcat x y)
  )
(cond  ((= (type id) 'str) (setq Rtn (str->list1 id)))
       ((= (type id) 'list) (setq Rtn (list->str1 id)))
       )
  Rtn
  )
;;;Examples:
;;;(vlxls-rangeid '(3 14)) return: "C14"
;;;(vlxls-rangeid "D23") return: (4 23)
;;;(vlxls-rangeid "DD23") return: (108 23)
(Defun vlxls-range-autofit (range);;自动调整范围内存储格
      (equal (vlax-variant-value
        (msxl-autofit
   (msxl-get-columns (msxl-get-Cells range))
   )
        )
      :vlax-true
      )
  )
;;;Examples:
;;;(vlxls-range-autofit (msxl-get-range *xlapp* "C12:F15")) return: T
;;;(vlxls-range-autofit RangeObject) return: NIL
(Defun vlxls-cell-put-active (xl id / Rtn);;范围内激活
  (if (= (type id) 'list)
    (setq id (vlxls-rangeid id))
    )
  (msxl-activate (setq Rtn (msxl-get-range xl id)))
  Rtn
  )
;;;Examples:
;;;(vlxls-cell-put-active *xlapp* "C12:F15") return: #
;;;(vlxls-cell-put-active *xlapp* "F12") return: #
(Defun vlxls-cell-get-value (xl id);;取得范围内值并列表
  (if (= (type id) 'list)
    (setq id (vlxls-rangeid id))
    )
  (vlxls-variant->list
    (msxl-get-value2 (msxl-get-range xl id))
    )
  )
;;;Examples:
;;;(vlxls-cell-get-value *xlapp* "C12") return: "g"
;;;(vlxls-cell-get-value *xlapp* "C12:C12") return: "g"
;;;(vlxls-cell-get-value *xlapp* "C12:C15") return: (("g") ("") ("") (""))
;;;(vlxls-cell-get-value *xlapp* "C12:F12") return: (("g" "ds" "" ""))
;;;(vlxls-cell-get-value *xlapp* "C12:F15") return: (("g" "ds" "" "") ("" "" "g" "") ("" "" "" "") ("" "" "" ""))
(Defun vlxls-cell-put-value (xl id Data / vllist-explode idx xx yy ary Rtn)
  ;;;;;将信息输入区域内
  (Defun vllist-explode1 (lst)
    (cond ((not lst) nil)
   ((atom lst) (list lst))
   ((append (vllist-explode1 (car lst))
     (vllist-explode1 (cdr lst))
     )))
    )
  (if (null id)
    (setq id "A1")
    )
  (if (= (type id) 'list)
    (setq id (vlxls-rangeid id))
    )
  (if (= (type (car Data)) 'LIST)
    (setq ARY (vlax-make-safearray
  vlax-vbstring(cons 0 (1- (length Data)))
  (cons 1 (length (car Data)))
  )
   XX  (1- (length (car Data)))
   YY  (1- (length Data))
   )
    (setq ARY (vlax-make-safearray
  vlax-vbstring
  (cons 0 1)
  (cons 1 (length Data))
  )
   XX  (1- (length Data))
   YY  0)
    )
  (if (= xx yy 0)
    (msxl-put-value2
      (setq Rtn (msxl-get-range xl id))
      (car (vllist-explode1 data))
      )
    (progn
      (setq id (vlxls-cellid-calc id xx yy))
      (msxl-put-value2
(setq Rtn (msxl-get-range xl id))
(vlax-safearray-fill ary data)
)
      )
    )
  Rtn
  )
;;;Examples:
;;;(vlxls-cell-put-value *xlapp* "C12" "xx") return: #
;;;(vlxls-cell-put-value *xlapp* "C12:F3" "xx") return: #
;;;(vlxls-cell-put-value *xlapp* "C12:D13" '(("zz" "xx")("xx" "zz"))) ereturn:
(Defun vlxls-cellid-calc (id x y / idx) ;;;计算范围
  (setq   id  (car (vlxls-cellid id))
   idx (vlxls-rangeid id)
   x   (+ x (car idx))
   x   (if    (< x 1)
  1
  x)
   y   (+ y (cadr idx))
   y   (if    (< y 1)
  1
  y)
   idx (vlxls-rangeid (list x y))
   id  (vlxls-cellid (strcat id ":" idx))
   id  (strcat (car id) ":" (cadr id))
   )
  id
  )
;;;Examples:
;;;(vlxls-cellid-calc "C12" 2 20) return: "C12:E32"
;;;(vlxls-cellid-calc '(2 23) 2 -120) return: "B1:D23"
(Defun vlxls-get-row-value (xl id len / vllist-explode Rtn);;取出单列的内容
  (Defun vllist-explode4  (lst)
    (cond ((not lst) nil)
   ((atom lst) (list lst))
   ((append (vllist-explode4 (car lst))
     (vllist-explode4 (cdr lst))
     )
    )
   )
    )
  (if (> len 0)
    (setq id (vlxls-cellid-calc id (1- len) 0))
    (setq id (vlxls-cellid-calc id (1+ len) 0))
    )
  (setq Rtn (vllist-explode4 (vlxls-cell-get-value xl id)))
  Rtn
  )
;;;Examples:
;;;(vlxls-get-row-value *xlapp* "C12" 2) return: ("zz" "xxx")
;;;(vlxls-get-row-value *xlapp* "C12" -20) return: ("" "" "zz")
(Defun vlxls-put-row-value (xl id data flg / Rtn);;;单列输入信息并且flg为t则自动调整尺寸
  (if (= (type data) 'str)
    (setq data (list data))
    )
  (setq   id (car (vlxls-cellid id))
   id (vlxls-cellid-calc id (1- (length data)) 0)
   )
  (setq Rtn (vlxls-cell-put-value xl id (list data)))
  (if flag
  (vlxls-range-autofit
    rtn
    ))
  Rtn
  )
;;;Examples:
;;;(vlxls-put-row-value *xlapp* "C12" "abc") return:#
;;;(vlxls-put-row-value *xlapp* '(12 3) "abc") return:#
;;;(vlxls-put-row-value *xlapp* "C12" '("zz" "xxx")) return:#
;;;(vlxls-put-row-value *xlapp* '(12 3) '("zz" "xxx")) return:#
(Defun vlxls-get-column-value (xl id len / vllist-explode Rtn);;取出单栏信息
  (Defun vllist-explode3       (lst)
    (cond ((not lst) nil)
   ((atom lst) (list lst))
   ((append (vllist-explode3 (car lst))
     (vllist-explode3 (cdr lst))
     )
    )
   )
    )
  (setq id (car (vlxls-cellid id)))
  (if (> len 0)
    (setq id (vlxls-cellid-calc id 0 (1- len)))
    (setq id (vlxls-cellid-calc id 0 (1+ len)))
    )
  (setq Rtn (vllist-explode3 (vlxls-cell-get-value xl id)))
  Rtn
  )
;;;Examples:
;;;(vlxls-get-column-value *xlapp* "C12" 2) return: ("zz" "sdfsdf")
;;;(vlxls-get-column-value *xlapp* "C12" -20) return: ("" "" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "xxx" "zz")
(Defun vlxls-put-column-value (xl id data flg / item Rtn);;;单栏输入信息并且flg为t则自动调整尺寸
  (if (= (type data) 'str)
    (setq data (list data))
    )
  (setq   id (car (vlxls-cellid id))
   id (vlxls-cellid-calc id 0 (1- (length data)))
   )
(foreach item    data
   (setq Rtn (cons (list item) Rtn)))
  (setq Rtn (vlxls-cell-put-value xl id (reverse Rtn)))
(if flg
   (vlxls-range-autofit
    rtn
   ))
  Rtn
  )
;;;Examples:
;;;(vlxls-put-column-value *xlapp* "C12" "abc") return: #
;;;(vlxls-put-column-value *xlapp* '(12 3) "abc") return: #
;;;(vlxls-put-column-value *xlapp* "C12" '("zz" "xxx")) return: #
;;;(vlxls-put-column-value *xlapp* '(12 3) '("zz" "xxx")) return: #
(Defun vlxls-cell-get-aci (xl id)
  (vlxls-color-eci->aci
    (vlax-variant-value
      (msxl-get-colorindex
(msxl-get-interior (msxl-get-range xl id))
)
      )
    )
  )
;;;Examples:
;;;(vlxls-cell-get-aci *xlapp* "C12") return:256
;;;(vlxls-cell-get-aci *xlapp* '(12 3)) return:15
(Defun vlxls-cell-put-aci (xl id aci / Rtn)
  (if (null aci)
    (msxl-put-colorindex
      (msxl-get-interior (setq Rtn (msxl-get-range xl id)))
      (vlax-make-variant -4142)
      )
    (msxl-put-colorindex
      (msxl-get-interior (setq Rtn (msxl-get-range xl id)))
      (vlxls-color-aci->eci aci)
      )
    )
  Rtn
  )
;;;Examples:
;;;(vlxls-cell-put-aci *xlapp* "C12" 6) return: #
;;;(vlxls-cell-put-aci *xlapp* "C12" nil) return: #
(Defun vlxls-text-get-aci (xl id)
  (vlxls-color-eci->aci
    (vlax-variant-value
      (msxl-get-colorindex
(msxl-get-font (msxl-get-range xl id))
)
      )
    )
  Rtn
  )
;;;Examples:
;;;(vlxls-text-get-aci *xlapp* "C12") return: 256
;;;(vlxls-text-get-aci *xlapp* '(12 3)) return: 15
(Defun vlxls-text-put-aci (xl id aci / Rtn)
   (if (null aci)
     (msxl-put-colorindex
       (msxl-get-font (setq Rtn (msxl-get-range xl id)))
       (vlax-make-variant -4105)
       )
     (msxl-put-colorindex
       (msxl-get-font (setq Rtn (msxl-get-range xl id)))
       (vlxls-color-aci->eci aci)
       )
     )
  Rtn
  )
;;;Examples:
;;;(vlxls-text-put-aci *xlapp* "C12" 6) return: #
;;;(vlxls-text-put-aci *xlapp* "C12" nil) return: #
(Defun vlxls-text-get-prop(xl id / Cell Font DXF1 DXF7 DXF40 DXF72 DXF62 DXF420 Rtn)
  ;;;;取得单元格文字相关信息
  (setq   id     (car (vlxls-cellid id))
   cell   (msxl-get-range xl id)
   font   (msxl-get-font cell)
   DXF7   (vlax-variant-value (msxl-get-name Font))
   DXF40  (vlax-variant-value (msxl-get-size Font))
   DXF72  (vlax-variant-value (msxl-get-HorizontalAlignment Cell)
     )
   DXF72  (cond ((= DXF72 -4152) 11)
         ((= DXF72 -4108) 10)
         (t 9)
         )
   DXF62  (vlxls-color-eci->aci
     (vlax-variant-value (msxl-get-colorIndex Font))
     )
   DXF420 (vlxls-color-eci->truecolor
     (vlax-variant-value (msxl-get-colorIndex Font)))
   Rtn    (list (cons 0 (strcase id))
         (cons 7 DXF7)(cons 40 DXF40)(cons 62 DXF62)
         (cons 72 DXF72)(cons 420 DXF420)))
  Rtn
  )
;;;Examples:
;;;(vlxls-text-get-prop *xlapp* "C12") return:((0 . "C12") (7 . "Arial") (40 . 12.0) (62 . 256) (72 . 9) (420 . 16711935))
;;;(vlxls-text-get-prop *xlapp* '(2 10)) return:((0 . "B10") (7 . "Arial") (40 . 12.0) (62 . 256) (72 . 11) (420 . 16711935))
(Defun vlxls-cell-get-prop(xl id / range left top width height dxf10 Rtn)
  ;;;;取得单元格信息
  (if (vlxls-cell-merge-p xl id)
     (setq id (vlxls-cell-get-mergeid xl id))
    )
  (setq   range  (msxl-get-range xl id)
   left   (vlax-variant-value (msxl-get-left Range))
   top    (vlax-variant-value (msxl-get-top Range))
   width  (vlax-variant-value (msxl-get-width Range))
   height (vlax-variant-value (msxl-get-height Range))
   dxf10  (list left top)
   Rtn    (list (cons 0 (strcase id))
         (cons 1 (vlxls-cell-get-value xl id))
         (cons 10 dxf10)
         (cons 41 width)
         (cons 42 height)
         (cons -1 (vlxls-text-get-prop xl id))
         )
   )
  Rtn
  )
;;;Examples:
;;;(vlxls-cell-get-prop *xlapp* "C12:F14") return:((0 . "C12:F14") (1 ("zz" "xxx" "xxx" "xxx") ("sdfsdf" "sdfsdf" "sdfsdf" "sdfsdf")
;;;          ("sdfsdf" "sdfsdf" "sdfsdf" "sdfsdf")) (10 108.0 156.75) (41 . 156.0) (42 . 42.75) (-1 (0 . "C12") (7 . "Arial")
;;;          (40 . 12.0) (62 . 256) (72 . 9) (420 . 16711935)))
;;;(vlxls-cell-get-prop *xlapp* "B8") return: ((0 . "B8") (1 . "sdg") (10 54.0 99.75) (41 . 54.0) (42 . 14.25) (-1 (0 . "B8")
;;;    (7 . "Arial") (40 . 12.0) (62 . 256) (72 . 10) (420 . 16711935)))
(Defun vlxls-cell-border (xl id flg / bdr);;;外框线
  (if flg
    (msxl-put-value
      (msxl-get-borders
(msxl-get-range xl id)
)
      1
      )
    (msxl-put-value
      (msxl-get-borders
(msxl-get-range xl id)
)
      'linestyle
msxl-xlnone
      )
    )
  )
;;;Examples:
;;;(vlxls-cell-border *xlapp* "C12:F14" T) return:NIL
;;;(vlxls-cell-border *xlapp* "B8" NIL) return:NIL
(Defun vlxls-cell-merge      (xl id / vllist-explode Val Rtn)
  ;;;;;;;;;合并单元格
  (Defun vllist-explode2       (lst)
    (cond ((not lst) nil)
   ((atom lst) (list lst))
   ((append (vllist-explode2 (car lst))
     (vllist-explode2 (cdr lst))
     )
    )
   )
    )
  (setq val (vllist-explode2 (vlxls-cell-get-value xl id)))
  (while (vl-position "" val)
    (setq val (vl-remove "" val))
    )
  (setq   val (car val)
   Rtn (msxl-get-range xl id)
   )
  (msxl-clear Rtn)
  (msxl-merge Rtn nil)
  (msxl-put-value2 Rtn Val)
  (msxl-put-HorizontalAlignment Rtn -4108)
  Rtn
  )
;;;Examples:
;;;(vlxls-cell-merge *xlapp* "C12:F14") return: #
(Defun vlxls-cell-unmerge (xl id / Rtn);;;取消合并单元格
  (if (vlxls-cell-merge-p xl id)
    (progn
      (vlax-invoke-method (msxl-get-range xl id) 'unmerge)
      (setq Rtn (msxl-get-range xl id))
      )
    )
  Rtn
  )
;;;Examples:
;;;(vlxls-cell-unmerge *xlapp* "C12:F14") return:#
;;;(vlxls-cell-unmerge *xlapp* "E14") return:#
(Defun vlxls-cell-merge-p (xl id);;;判断单元格是否合并
  (equal (vlax-variant-value
    (msxl-get-mergecells (msxl-get-range xl id))
    )
  :vlax-true
  )
  )
;;;Examples:
;;;(vlxls-cell-merge-p *xlapp* "C12:F14") return:T
;;;(vlxls-cell-merge-p *xlapp* "E14") return:NIL
(Defun vlxls-cell-get-mergeid (XL ID / Rtn);;;取得单元格合并的范围
  (if (vlxls-cell-merge-p xl id)
    (progn
      (msxl-select (msxl-get-range xl id))
      (setq Rtn (vlxls-range-getid (msxl-get-selection xl)))
      )
    )
  Rtn
  )
;;;Examples:
;;;(vlxls-cell-get-mergeid *xlapp* "C12:F14") return: "B9:G19"
;;;(vlxls-cell-get-mergeid *xlapp* "E14") return: "A11:G19
(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)))))
)
;;;Examples:
;;;(vlxls-range-getid RangeObject) return: "C12:G19"
;;;(vlxls-range-getid RangeObject) return: "B16:B16"
(Defun vlxls-range-size      (range / xl row col rrr ccc xxx yyy);;;;取得单元范围尺寸
  (setq   xl  (msxl-get-parent range)
   Row (msxl-get-count (msxl-get-rows Range))
   Col (msxl-get-count (msxl-get-columns Range))
   RRR (1- (msxl-get-row Range))
   CCC (msxl-get-column Range)
   )
  (repeat Row
    (setq yyy (cons   (vlax-variant-value
   (msxl-get-height
     (msxl-get-range
       xl
       (vlxls-rangeid (list CCC (setq RRR (1+ RRR))))
       )
     )
   )
        yyy
        )
   )
    )
  (setq   RRR (msxl-get-row Range)
   CCC (1- (msxl-get-column Range))
   )
  (repeat Col
    (setq xxx (cons   (vlax-variant-value
   (msxl-get-width
     (msxl-get-range
       xl
       (vlxls-rangeid (list (setq CCC (1+ CCC)) RRR))
       )
     )
   )
        xxx
        )
   )
    )
  (list (reverse xxx) (reverse yyy))
  )
;;;Examples:
;;;(vlxls-range-size RangeObject) return: ((27.0 27.0 110.25 51.0 69.75) (14.25 14.25 14.25 14.25 14.25 57.0 14.25))
(Defun vlxls-Rangevalue->SafeArray (Data / XSub_GetXY XSub_GetMinMaxID xsub-MergeID->List
        MinID MaxID ID ID1 ID2 IDN X minid xy Y Rtn Item)
  ;;;;;;;;;;;;;安全数组
  (Defun xsub-MergeID->List1 (ID / KK ID1 ID2 IDX IDY Rtn)
    (Setq ID (strcase ID))
    (if    (setq KK (vl-string-search ":" ID))
      (setq ID1   (substr ID 1 KK)
     ID2  (substr ID (+ 2 KK))
     )
      (setq ID1   ID
     ID2  ID)
      )
    (setq ID1 (vlxls-rangeid ID1)
   ID2 (vlxls-rangeid ID2)
   IDX (vlxls-rangeid
  (list (min (nth 0 ID1) (nth 0 ID2))
        (min (nth 1 ID1) (nth 1 ID2))
        )
  )
   IDY
    (vlxls-rangeid
      (list (max (nth 0 ID1) (nth 0 ID2))
     (max (nth 1 ID1) (nth 1 ID2))
     )
      )
   Rtn (list IDX IDY)
   )
    Rtn
    )
  (Defun XSub_GetXY1 (ID SID / S10 S11 DX DY Rtn)
    (setq S10 (nth 0 MinID)
   S11 (nth 1 MinID)
   ID  (vlxls-rangeid ID)
   DX  (- (nth 0 ID) S10)
   DY  (- (nth 1 ID) S11)
   Rtn (list DX DY)
   )
    Rtn
    )
  (Defun XSub_GetMinMaxID1 (ID1 ID MinorMax / X Y X1 Y1 Rtn)
    (if    (null ID)
      (setq Rtn ID1)
      (progn
(setq ID1 (vlxls-rangeid ID1)
       ID  (vlxls-rangeid ID)
       X1  (nth 0 ID1)
       Y1  (nth 1 ID1)
       X    (nth 0 ID)
       Y   (nth 1 ID)
       )
(if (null MinorMax)
   (setq Rtn (vlxls-rangeid (list (min X X1) (min Y Y1))))
   (setq Rtn (vlxls-rangeid (list (max X X1) (max Y Y1))))
   )
)
      )
    Rtn
    )
  (foreach Item    Data
    (setq ID (strcase (car Item)))
    (if    (vl-string-search ":" ID)
      (setq IDN (xsub-MergeID->List1 ID))
      (setq IDN (list ID))
      )
    (foreach ID    IDN
      (setq MinID (XSub_GetMinMaxID1 ID MinID nil)
     MaxID (XSub_GetMinMaxID1 ID MaxID T)
    )
      )
    )
  (setq   MinID (vlxls-rangeid MinID)
   MaxID (vlxls-rangeid MaxID)
   X     (- (nth 0 MaxID) (nth 0 MinID))
   Y     (- (nth 1 MaxID) (nth 1 MinID))
   Rtn   (vlax-make-safearray
    vlax-vbstring
    (cons 0 Y)
    (cons 1 (1+ X))
    )
   )
  (foreach Item    Data
    (setq ID (strcase (car Item)))
    (if    (vl-string-search ":" ID)
      (setq IDN (xsub-MergeID->List1 ID))
      (setq IDN (list ID))
      )
    (foreach ID    IDN
      (setq XY (XSub_GetXY1 ID MinID))
      (vlax-safearray-put-element
Rtn
(nth 1 XY)
(1+ (nth 0 XY))
(cdr Item)
)
      )
    )
  Rtn
  )
;;;Examples:
;;;(vlxls-rangevalue->safearray '(("A1" . "aaa")("B4" . "ccc"))) return: #
;;;(vlxls-variant->list (vlxls-rangevalue->safearray '(("A1" . "aaa")("B4" . "ccc")))) return: (("aaa" "") ("" "") ("" "") ("" "ccc"))
(Defun vlxls-get-property (top prop / item Rtn);vlstring->list
  ;;;;取得多重属性
  (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))))
)
      (setq
str
  (substr str (+ (1+ (strlen st)) (vl-string-search st str)))
)
      )
    (if    lst
      (mapcar '(lambda (e) (vl-string-trim " " e)) lst)
      )
    )
  (cond  ((= (type prop) 'sym)
   (setq Rtn (vlax-get-property top prop))
   )
  ((= (type prop) 'str)
   (if (null (vl-string-search "." prop))
     (setq Rtn (vlax-get-property top prop))
     (foreach item (vlstring->list prop ".")
       (if (null Rtn)
  (setq Rtn (vlax-get-property top item))
  (setq Rtn (vlax-get-property Rtn item))
  ))))
  )
  (cond  ((= (type Rtn) 'variant)
   (setq Rtn (vlax-variant-value Rtn))
   )
  ((= (type Rtn) 'safearray)
   (setq Rtn (vlxls-variant->list Rtn))
   )
  )
  Rtn
  )
;;;Examples:
;;;(vlxls-get-property RangeObject "Application.ActiveSheet.Name") return: "Sheet1"
;;;(vlxls-get-property RangeObject "MergeArea.Columns.Count") return: 3
(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)
      )
      *Chinese* t
      )
(if vl-load-com
  (vl-load-com))
(if vl-arx-import
  (foreach item    '(ACAD_COLORDLG       ACAD_truecolordlg
       ACAD_STRLSORT      INITDIA
       ACAD-POP-DBMOD     ACAD-PUSH-DBMOD
       STARTAPP            layoutlist
       )
    (vl-arx-import item)
    )
  )
(setq item   nil
      *xls-ver*     "1.1.40715"
      )
(princ
  (strcat "\n VLAE:VLXLS Freebie API Version " *xls-ver*)
  )
(princ
  "\n Copyright(C) 1994-2005 KozMos Inc. All rights reserved"
  )
(princ)
(defun vlxls-ScreenUpdating-Off  (*xlapp*)
  (vlax-put-property *xlapp* 'ScreenUpdating 0))
(defun vlxls-ScreenUpdating-On  (*xlapp*)
  (vlax-put-property *xlapp* 'ScreenUpdating -1))
;;*************************************************************************
;;; 模块： vlxls-Excel-ColumnWidth
;;; 描述： 调整宽度col为width
;;; 参数： sheet (object)
;;; 示例： (vlxls-Excel-ColumnWidth xlapp 2 12);;调整B栏宽为12
;;;*************************************************************************
(defun vlxls-ColumnWidth(xlapp col width / sheet cell)
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (vlax-put-property (setq cell (vlxls-get-cell sheet 1 col)) "ColumnWidth"
width)
  )
;;;*************************************************************************
;;; 模块： mSX-Excel-RowHeight
;;; 描述： 调整列高row为height
;;; 参数： sheet (object)
;;; 示例： (mSX-Excel-ColumnWidth xlapp 3 15);;调整3列高为15
;;;*************************************************************************
(defun vlxls-RowHeight(xlapp row height / sheet cell)
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (vlax-put-property (setq cell (vlxls-get-cell sheet row 1)) "RowHeight"
height)
  )
(defun vlxls-get-cell  (obj row col / item cells)
  (setq item (vlax-get-property
    (setq cells (vlax-get-property obj "Cells"))
    "Item"
    (vlax-make-variant row)
    (vlax-make-variant col)))
  (vlax-release-object cells)
  (vlax-variant-value item))
(defun vlxls-put-pagesetup(xlapp top bot lef rig hea fot flh flv);;设置版面
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (setq page (vlax-get-property sheet "pagesetup"))
  (vlax-put-property page "footermargin" (* fot 28.3465))
  (vlax-put-property page "headermargin" (* hea 28.3465))
  (vlax-put-property page "leftmargin" (* lef 28.3465))
  (vlax-put-property page "rightmargin" (* 28.3465 rig))
  (vlax-put-property page "topmargin" (* top 28.3465))
  (vlax-put-property page "bottommargin" (* bot 28.3465))
  (vlax-put-property page "CenterHorizontally" (* 28.3465 flh))
  (vlax-put-property page "CenterVertically" (* flv 28.3465))
  )
;;;*************************************************************************
;;; 模块： vlxls-Excel-cellfontname
;;; 描述： 更改单元格字体
;;; 参数： row col name
;;; 示例： (vlxls-Excel-cellfontname 2 3 "新细明体");;更改单元格C2字体为"新细明体"
;;;*************************************************************************
(defun vlxls-Excel-cellfontname(xlapp row col name / sheet cell)
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (vlax-put-property(vlax-get-property (setq cell (msx-get-cell sheet row col)) "font"
) "name" name
  ))
;;;*************************************************************************
;;; 模块： vlxls-Excel-cellcolor
;;; 描述： 更改单元格颜色
;;; 参数： row col color
;;; 示例： (vlxls-Excel-cellcolor2 3 14);;更改单元格C2为14号色
;;;*************************************************************************
(defun vlxls-Excel-cellcolor(xlapp row col color / sheet cell)
  (setq sheet (vlax-get-property xlapp  "ActiveSheet"))
  (setq cell (vlxls-get-cell sheet row col))
  (msxl-put-ColorIndex (msxl-get-Interior cell) color))
;;;*************************************************************************
;;; 模块： vlxls-Excel-textcolor
;;; 描述： 更改单元格文字颜色
;;; 参数： row col color
;;; 示例： (vlxls-Excel-textcolor 2 3 14);;更改单元格C2文字为14号色
;;;*************************************************************************
(defun vlxls-Excel-textcolor(xlapp row col color / sheet cell)
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (setq cell (vlxls-get-cell sheet row col))
  (vlax-put-property (vlax-get-property cell "font") "ColorIndex" color))
;;;*************************************************************************
;;; 模块： vlxls-Excel-textsize
;;; 描述： 更改单元格文字大小
;;; 参数： row col size
;;; 示例： (vlxls-Excel-textsize 2 3 18);;更改单元格C2文字为18号字大小
;;;*************************************************************************
(defun vlxls-Excel-textsize(xlapp row col size / sheet cell)
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (setq cell (vlxls-get-cell sheet row col))
  (vlax-put-property (vlax-get-property cell "font") "Size" size))
;;;*************************************************************************
;;; 模块： vlxls-Excel-textunderline
;;; 描述： 更改单元格文字下画线
;;; 参数： row col size
;;; 示例： (vlxls-Excel-textunderline 2 3 1);;更改单元格C2文字无下划线
;;;*************************************************************************
(defun vlxls-Excel-textunderline(xlapp row col underline / sheet cell)
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (setq cell (vlxls-get-cell sheet row col))
  (vlax-put-property (vlax-get-property cell "font") "Underline" underline))
;;;;;注:   underline 1---------无下划线
;;;;;                2---------单线
;;;;;                3---------双线
;;;;;                4---------会计用单线
;;;;;                5---------会计用双线

;;;*************************************************************************
;;; 模块： vlxls-Excel-fontstyle
;;; 描述： 更改单元格文字形式
;;; 参数： row col color
;;; 示例： (vlxls-Excel-fontstyle 2 3 "粗体");;更改单元格C2文字为14粗体
;;;*************************************************************************
(defun vlxls-Excel-fontstyle(xlapp row col style / sheet cell)
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (setq cell (vlxls-get-cell sheet row col))
  (vlax-put-property (vlax-get-property cell "font") "FontStyle" style))
;;;*************************************************************************
;;; 模块： vlxls-Excel-fontspecial
;;; 描述： 更改单元格文字特殊效果
;;; 参数： row col color
;;; 示例： (vlxls-Excel-fontspecial 2 3 "Strikethrough" item);;更改单元格C2文字特殊效果为删线
;;;        "Superscript"为上标 "Subscript" 为下标 (item设置为0则停用,-1为启用)
;;;*************************************************************************
(defun vlxls-Excel-fontspecial(xlapp row col special item / sheet cell)
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (setq cell (vlxls-get-cell sheet row col))
  (vlax-put-property (vlax-get-property cell "font") special item))
;;;*************************************************************************
;;; 模块： vlxls-Excel-textAlignment
;;; 描述： 更改单元格文字对齐方式
;;; 参数： row col color hal val
;;; 示例： (vlxls-Excel-textAlignment 2 3 1 -4108);;更改单元格C2文字对齐方式水平方向一般﹐垂直置中
;;;*************************************************************************
(defun vlxls-Excel-textAlignment(xlapp row col hal val / sheet cell)
  (setq sheet (vlax-get-property xlapp  "ActiveSheet"))
  (setq cell (vlxls-get-cell sheet row col))
  (vlax-put-property  cell  "HorizontalAlignment" hal)
  (vlax-put-property  cell  "VerticalAlignment" val))
;;;注:水平方式  1    ----------一般               
;;;;;;;;;      -4131----------左缩排 ;;;;或2
;;;;;;;;;      -4108----------置中对齐 ;;或3
;;;;;;;;;      -4152----------靠右对齐 ;;或4
;;;;;;;;;      5    ----------填满     ;;或5
;;;;;;;;;      -4130----------水平对齐 ;;或6
;;;;;;;;;          7----------跨栏置中  
;;;;;;;;;      -4117----------分散对齐  ;;或8
;;;注:垂直方式  -4160 ----------靠上        或1      
;;;;;;;;;       -4108----------置中对齐     或2
;;;;;;;;;       -4107----------靠下         或3
;;;;;;;;;       -4130----------垂直对齐     或4
;;;;;;;;;       -4117 ----------分散对齐    或5
;==============================================================================
;LISP中表是存储各类数据的有效方式，从其中读取值的函数较多，有：
;nth,assoc,car,cdr等，但是修改值很不方便，如果涉及到修改个数较多，
;例如排序操作，可以参考一下例子，需要掌握的函数包括set,read,eval
;==============================================================================
;  功能：开始列表处理函数
;  参数：vlist 需要进行大量修改的表，在后续操作中不能更改表的大小
;        vid   本次列表操作处理序号，是为了为能够同时进行多个列表操作
;  返回值： 列表长度
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun startvlist(vlist vid / num vnhead vn n)
  (setq num (length vlist)
  ;单个变量名头，为全局变量，为不破坏其他程序使用的全局变量，故名称挺特别
        vnhead (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_")        
        n 0        
  )
  ;记录列表长度，用以判断后续操作是否越界
  (set (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")) num)
  (repeat num
    (setq vn (strcat vnhead (itoa n)))
    (set (read vn) (nth n vlist))
    (setq n (1+ n))
  )  
)
;==============================================================================
;  功能：获取表中某个位置变量读写位置别名
;  参数：vid 同startvlist   
;        index 列表中变量序号，从0开始计数
;  返回值： 表中第index个元素存储变量名称
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun [](vid index / num vnhead)  
  (setq num (eval (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num"))))
  (if (or (< index 0) (>= index num))
    (progn
      (print "访问表元素越界")
      (exit)
    )
  )  
  ;单个变量名头，为全局变量，为不破坏其他程序使用的全局变量，故名称挺特别  
  (setq vnhead (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_"))
  (read (strcat vnhead (itoa index)))
)
;==============================================================================
;  功能：获取表中某个位置变量值
;  参数：vid 同startvlist      
;        index 列表中变量序号，从0开始计数
;  返回值： 表中第index个元素存储变量当前值         
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun hget(vid index / )   
  (eval ([] vid index))
)
;==============================================================================
;  功能：设置表中某个元素当前变量值
;  参数：vid 同startvlist      
;        index 列表中变量序号，从0开始计数
;        value 需要赋的值
;  返回值：新赋的值
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun hset(vid index value / )   
  (set ([] vid index) value)
)
;==============================================================================
;  功能：交换表中两个元素的值
;  参数：vid 同startvlist  
;        index1，index2 列表中变量序号，从0开始计数
;  返回值： 修改后index2中元素的值
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun swap(vid index1 index2 / tmpv)   
  (setq tmpv (hget vid index1))
  (hset vid index1 (hget vid index2))
  (hset vid index2 tmpv)
)
;==============================================================================
;  功能：插入一个元素
;  参数：vid 同startvlist  
;        index，插入到列表的序号，从0开始计数
;  返回值：新插入元素的值
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun vinsert1(vid index value / n num tmpv)   
  (setq num (eval (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num"))))
  (if (or (< index 0) (> index num))
    (progn
      (print "访问表元素越界")
      (exit)
    )
  )
  (set (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")) (1+ num))
  (setq n num)  
  (while (> n index)
    (hset vid n (hget vid (1- n)))
    (setq n (1- n))  
  )     
  (hset vid index value)  
)
;==============================================================================
;  功能：连续插入多个元素
;  参数：vid 同startvlist  
;        index，插入到列表的序号，从0开始计数
;        vaulelist 插入值列表。
;  返回值：新插入最后一个元素的值
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun vinsert2(vid index valuelist / num num1 n)   
  (setq num (eval (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")))
        num1 (length valuelist)      
  )
  (if (or (< index 0) (> index num))
    (progn
      (print "访问表元素越界")
      (exit)
    )
  )
  (set (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")) (+ num num1))  
  (setq n num num1 (1- num1))  
  (while (> n index)
    (hset vid (+ n num1) (hget vid (1- n)))
    (setq n (1- n))  
  )
  (setq n -1 index (1- index) )   
  (repeat (1+ num1)
    (setq index (1+ index)
          n (1+ n)         
    )  
    (hset vid index (nth n valuelist))   
  )  
)
;==============================================================================
;  功能：删除一个元素
;  参数：vid 同startvlist  
;        index，要删除列表元素的序号，从0开始计数
;  返回值：删除后表的长度
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun vdelete1(vid index / num)   
  (setq num (eval (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num"))))
  (if (or (< index 0) (>= index num))
    (progn
      (print "访问表元素越界")
      (exit)
    )
  )   
  (while (< index (1- num))
    (hset vid index (hget vid (1+ index)))  
    (setq index (1+ index))  
  )  
  (hset vid index nil);释放变量   
  (set (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")) (1- num))
)
;==============================================================================
;  功能：连续删除多个元素
;  参数：vid 同startvlist  
;        index，要删除列表元素的起始序号，从0开始计数
;        dnum 要删除列表元素的个数。
;  返回值：删除后表的长度  
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun vdelete2(vid index dnum / num n)   
  (setq num (eval (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num"))))
  (if (or (< index 0) (>= (+ index dnum) num))
    (progn
      (print "访问表元素越界")
      (exit)
    )
  )
  (setq n (+ index dnum))
  (while (< n num)
    (hset vid index (hget vid n))
    (setq index (1+ index)
          n (1+ n)
    )   
  )  
  (repeat dnum
     (hset vid index nil);释放变量  
     (setq index (1+ index))
  )   
  (set (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")) (- num dnum))
)
;==============================================================================
;  功能：结束列表处理函数
;  参数：num 原始vlist表长度，
;        vid 同startvlist        
;  返回值：修改后的表
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun endvlist(vid / vlist num vnhead vn n)
  (setq ;单个变量名头，为全局变量，为不破坏其他程序使用的全局变量，故名称挺特别
        vnhead (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_")
        n 0
        vlist '()
        num (eval (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")))        
  )
  (repeat num
    (setq vlist (append vlist (list (hget vid n))))
    (hset vid n nil);释放变量
    (setq n (1+ n))
  )
  (set (read (strcat "HUA_VNHEAD!@#$%^&*_" (itoa vid) "_num")) nil)
  vlist
)
;==============================================================================
;  功能：表排序函数
;  参数：vlist 需要进行排序的表
;        vid   本次列表操作处理序号，是为了为能够同时进行多个列表操作
;        comparefun 排序函数，该函数接受两个表元素作为参数，
;                如果其返回值是nil,表示两个元素要交换位置,否则不需要
;  返回值：排序后的表
;  编制：华亮春   2009年02月25日
;==============================================================================
(defun sortlist(vlist vid comparefun / num flag i j)
  (setq num (startvlist vlist vid)      
        i 1
        flag T
  )
  ;冒泡排序
  (while (and flag (< i num))
    (setq flag nil j (- num 2))
    (repeat (- num i)
      (if (not(comparefun (hget vid j) (hget vid (1+ j))))
        (progn
          (swap vid j (1+ j))
          (setq flag T)
        )        
      )
      (setq j (1- j))      
    )
    (setq i (1+ i))   
  )  
  (endvlist vid)
)
;==============================================================================
;;例子，读取LWPOLYLINE线坐标，并按Y方向从大到小排序
(defun getlwcoords(en / el ptnum closeFlag points pt)
  (setq el (entget en))
  (if (not el)
    (exit)
  )
  (setq ptnum (cdr (assoc 90 el))
        closeFlag (cdr (assoc 70 el))
        points '()
  )
  (repeat ptnum
    (setq pt (cdr (assoc 10 el))
          el (cdr (member (cons 10 pt) el))
          points (append points (list pt))
    )   
  )
  points
)
(defun mycompare(pt1 pt2)
  (> (cadr pt1) (cadr pt2))
)
(defun C:test(/ ss points num n)
  (setq ss (ssget ":s" '((0 . "lwpolyline"))))
  (if (not ss)
    (exit)
  )
  (setq points (getlwcoords (ssname ss 0))
        points (sortlist points 1 mycompare)
        num (length points)
        n 0
  )
  (repeat num   
    (entmake (list '(0 . "text") (cons 10 (nth n points)) (cons 1 (itoa (setq n (1+ n))))
     '(40 . 20.0)'(41 . 0.75)))   
  )
  (princ)
)