[文章]：淺探VLISP使用EXCEL

舟自横

最近看到論壇上關于如何用VLISP將CAD與EXCEL聯系起來的討論
比較多，看來還是有許多愛好者喜歡進行這方面的探索，以前有看過衛文斑竹的几篇文章和程序覺得很不錯，今天一時技癢，也想來對EXCEL發表一些見解。因為在我工作中經常需要將CAD與EXCEL聯系起來用所以我也是在沒有辦法的情況下才去進行這方面的研究，寫的不好還希望大家多提出意見。。多多討論。。
首先我認為想要學好這個并不難要有耐心，比如有些屬性我不知道怎么去使用，沒有關系VLISP給了我們一個很好的函數VLAX-DUMP-OBJECT函數去查詢然后對照他所有的功能用VLAX-GET-PROPERTY和VLAX-PUT-PROPERTY兩個功能基本上都可以實現屬性的編輯。。
  我的調用習慣是 1.初始化EXCEL---2.新建進程----3.設定版面
                 4.表格處理(如:何處需要合并單元格以及邊框線
                   設定等)
                                   5.存儲數據
1....初始化進程
(Defun hyxls-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 件到99849930449@sina.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
  )
進程初始化完畢,已經找到你電腦上EXCEL所在位置及版本下面就可以新建立檔案了。
2...新建檔案
  (Defun hyxls-app-New (UnHide / Rtn)
  ;;;; 該程序實現功能:新建一個excel格
  ;;;;;;;;;; THIS PROGRAM CAN BUILD A NEW EXCELFILE
  (if (hyxls-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
  )
用UNHIDE來控制是否為隱藏功能。
如果說你需要的不是新建檔案而是需要調用一個就檔案的話。
(Defun hyxls-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)
3..好了，現在檔案進程已經取得那么就可以開始設計你需要的版面了.(打印時需要的格式，此時你電腦上必須有安裝打印設備，要不然VLISP將無法取得屬性，產生錯誤）
(defun hyxls-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" flh)
  (vlax-put-property page "CenterVertically" flv )
  )
;;top為頂部距離，bot為底部距離，......flh,和flv是表示水平和垂直置中設定為1表示選定0表示取消，其中的每一項參數大家可以自己逐個去使用一下我就不多講了
4.版面設定好下面就是設定格式
;;;  更改范圍中邊框形式
(defun hyxls-Excel-rangeborder (xlapp star end style1 style2 style3 style4 style5 style6
                                / sheet range borders left top right bottom)
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (setq range (msxl-get-range  sheet (STRCAT star ":" end)))
  (setq borders (msxl-get-borders range))
  (setq left(vlax-get-property borders 'item 1)
        top(vlax-get-property borders 'item 3)
        right(vlax-get-property borders 'item 2)
        bottom(vlax-get-property borders 'item 4)
        )
  (if style1 (vlax-put-property left 'linestyle style1))
  (if style2 (vlax-put-property top 'linestyle style2))
  (if style3 (vlax-put-property right 'linestyle style3))
  (if style4 (vlax-put-property bottom 'linestyle style4))
  (if (and  style5 (= star end))  (progn (setq mid1(vlax-get-property borders 'item 5)
                          )
                       (vlax-put-property mid1 'linestyle style5)
                      )
    )
  (if (and style6 (= star end))  (progn (setq mid2(vlax-get-property borders 'item 6)
                          )
                       (vlax-put-property mid2 'linestyle style6)
                      )
    )
  )
;;;;;;;注:   1............單細線
;;;          2............細虛線
;;;          3............細虛線(比例比2小)
;;;          4............點划線
;;;          5............雙點划線
;;;          6............雙重雙點划線
;;;          7............=1
;;;          8............=2
;;;          9............雙划線
;;;          10...........=4
;;;          11...........=5
;;;          12...........=9
;;;          13...........=6

;;;合并單元格
(Defun hyxls-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 (hyxls-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:
;;;(hyxls-cell-merge *xlapp* “C1:F14”)

5..好了，一切前提工作全部做好了下面的就是要存儲數據了
(Defun hyxls-range-autofit (range);;自動調整范圍內存儲格
      (equal (vlax-variant-value
               (msxl-autofit
                 (msxl-get-columns (msxl-get-Cells range))
                 )
               )
             :vlax-true
             )
  )
  ;;存儲信息到一橫行。。（信息為列表形式）
(Defun hyxls-put-row-value (xl id data flg / Rtn);;;單列輸入信息并且flg為t則自動調整尺寸
  (if (= (type data) 'str)
    (setq data (list data))
    )
  (setq   id (car (hyxls-cellid id))
          id (hyxls-cellid-calc id (1- (length data)) 0)
          )
  (setq Rtn (hyxls-cell-put-value xl id (list data)))
  (if flag
  (hyxls-range-autofit
    rtn
    ))
  Rtn
  )
;;;;存儲信息到一豎列。。（信息為列表形式）
Defun hyxls-put-column-value (xl id data flg / item Rtn);;;單列輸入信息并且flg為t則自動調整尺寸
  (if (= (type data) 'str)
    (setq data (list data))
    )
  (setq   id (car (hyxls-cellid id))
          id (hyxls-cellid-calc id 0 (1- (length data)))
          )
(foreach item    data
   (setq Rtn (cons (list item) Rtn)))
  (setq Rtn (hyxls-cell-put-value xl id (reverse Rtn)))
(if flg
   (hyxls-range-autofit
    rtn
   ))
  Rtn
  )
6...信息存儲完畢，我們將需要存盤并退出.
   (Defun hyxls-app-save (xlapp)
  ;;;;保存文件
  (equal (vlax-invoke-method
         (vlax-get-property Xlapp "ActiveWorkbook")"Save")
         :vlax-true)
  )
(Defun hyxls-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)
  )
。。。大致一個使用過程就是這樣了。。
其他還有一些細節，比如如何改變字體字型，顏色，加信息，
調整字高等大家可以自己慢慢研究。。
再加几個相關程序。。

(defun hyxls-Excel-textAlignment(xlapp row col hal val / sheet cell)
  (setq sheet (vlax-get-property xlapp  "ActiveSheet"))
  (setq cell (hyxls-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

(defun hyxls-Excel-textunderline(xlapp row col underline / sheet cell)
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (setq cell (hyxls-get-cell sheet row col))
  (vlax-put-property (vlax-get-property cell "font") "Underline" underline))
;;;;;注:   underline 1---------無下划線
;;;;;                2---------單線
;;;;;                3---------雙線
;;;;;                4---------會計用單線
;;;;;                5---------會計用雙線
(defun hyxls-Excel-textsize(xlapp row col size / sheet cell)
  (setq sheet (vlax-get-property xlapp "ActiveSheet"))
  (setq cell (hyxls-get-cell sheet row col))
  (vlax-put-property (vlax-get-property cell "font") "Size" size))

lxz0929

那如何与主函数进行联系呢？运用哪些函数进行调用？

舟自横

其中有一個xlapp參數是聯系的紐帶。。
比如要新建一個EXCEL檔案
(hyxls-app-init)
(setq xlapp (hyxls-app-New t))
就可以,以后中這個進程就被設定為參數xlapp了。。。

它山之石

论坛里有几个对这个问题研究得很深的牛人。
但舟自横能提供如此详细的样例。
俺支持。

这个网址提供了一个相关的函数。大家可以看看。
作者在本论坛叫“mmmm”。
www.ikozmos.com

lxz0929

3楼楼主，我还是不太明白你说的什么意思！下面是我的一个程序，主函数是我编的，其余的是我抄别人的，现在的问题是它只运行主函数，EXCEL方面的没有动静，不知能不能帮我看一下！(Defun C:SPLL()
  (vl-load-com)
       (PrinC "\n这是对 Spline 进行数据分析的基本程序...")
       (While(progn(setq pen(car(entsel "\n指定一条 Spline: ")))
                        (/= "LWPOLYLINE"(cdr(assoc 0 (entget pen))))
                )
                (Alert "所指对象不是 Spline，请重新指定...")
       )
  (princ "\这是一条：")
  (setq s (getstring))
  (princ "\请选择原点：")
  (setq pt1(getpoint))
  (print pt1)
  (setq a1(car pt1))
  (setq a2(cadr pt1))
  (setq ent(entget pen))
  (setq ct 0)
  (textpage)
  (princ"\n 拟合点的坐标值:")
  (setq c1(length ent))
  (while(< ct c1)
   (setq d2(car(nth ct ent)))
      (if(= 10 d2)
(progn
   (setq d3(cdr(nth ct ent)))
   (setq b1(car d3))
   (setq b2(cadr d3))
   (setq b1(- b1 a1))
   (setq b1(abs b1))
   (setq b2(- b2 a2))
   (setq b2(abs b2))
   (print b1)
   (print b2)
   )
      )
   (setq ct(+ 1 ct))
  )
  (print)
(vl-load-com)
(defun DSX-TypeLib-Excel ( / sysdrv tlb)
(setq sysdrv (getenv "systemdrive"))
(cond
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel8.olb")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel9.olb")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel10.olb")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel.exe")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office11\\Excel.exe")))
tlb
)
)
)
(defun DSX-Load-TypeLib-Excel ( / tlbfile tlbver out)
(cond
( (null msxl-xl24HourClock)
(if (setq tlbfile (DSX-TypeLib-Excel))
(progn
(setq tlbver (substr (vl-filename-base tlbfile) 6))
(cond
( (= tlbver "9")
(princ "\n初始化 Microsoft Excel 2000...") )
( (= tlbver "8")
(princ "\n初始化 Microsoft Excel 97...") )
( (= (vl-filename-base tlbfile) "Excel.exe")
(princ "\n初始化 Microsoft Excel 2003...")
)
)
(vlax-import-type-library
:tlb-filename tlbfile
:methods-prefix "msxm-"
:properties-prefix "msxp-"
:constants-prefix "msxc-"
)
(if msxl-xl24HourClock (setq out T))
)
)
)
( T (setq out T) )
)
out
)
(defun DSX-Open-Excel-New (dmode / appsession)
(princ "\n创建一个新的 Excel 电子表格文件...")
(cond
( (setq appsession (vlax-create-object "Excel.Application"))
(vlax-invoke-method (vlax-get-property appsession 'WorkBooks) 'Add)
(if (= (strcase dmode) "SHOW")
(vla-put-visible appsession 1)
(vla-put-visible appsession 0)
)
)
)appsession
)
(defun DSX-Excel-Put-RowList (lst startrow startcol)
(foreach itm lst
(msxl-put-value
(DSX-Excel-Get-Cell range startrow startcol)
itm
)
(setq startcol (1+ startcol))
)
)
)

因为我是初学者，而且是作毕业设计用的，所以恳请帮帮忙！快没时间了！先谢了！

舟自横

你的程序我大致看了一下，有很多問題。。
最主要的是，你對如何調用子程序結構不是很
明白。。建議你多看一下書，或者別人如何使用
子程序的。。
舉個你程序里面最簡單的錯誤:你在主函數里面定義
DSX-Open-Excel-New子函數當然這種方法沒有錯，但是
你定義了又在哪里調用他了呢?
你這樣的作用只是相當于把子函數加載了一下而已，
當然EXCEL就不理你拉。。
DSX-Excel-Put-RowList這個函數也是一樣。。
好了言歸正傳，給你稍做修正。。

(Defun hyxls-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 件到99849930449@sina.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:
;;;(hyxls-app-init) return: 33

(Defun hyxls-app-New (UnHide / Rtn)
  ;;;; 該程序實現功能:新建一個excel格
  ;;;;;;;;;; THIS PROGRAM CAN BUILD A NEW EXCELFILE
  (if (hyxls-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
  )
(Defun hyxls-cellid (id / xx id1 id2 Rtn) ;;;;cell id 轉換
  (if (= (type id) 'list)
    (setq id (hyxls-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 (hyxls-rangeid id1)
        id2 (hyxls-rangeid id2)
        Rtn (list (hyxls-rangeid (list (min (car id1) (car id2))
   (min (cadr id1) (cadr id2))))
                  (hyxls-rangeid (list (max (car id1) (car id2))
                                       (max (cadr id1) (cadr id2)))))
        )
    )
  Rtn
  )
(Defun hyxls-put-row-value (xl id data flg / Rtn);;;單列輸入信息并且flg為t則自動調整尺寸
  (if (= (type data) 'str)
    (setq data (list data))
    )
  (setq   id (car (hyxls-cellid id))
          id (hyxls-cellid-calc id (1- (length data)) 0)
          )
  (setq Rtn (hyxls-cell-put-value xl id (list data)))
  (if flag
  (hyxls-range-autofit
    rtn
    ))
  Rtn
  )
(defun hyxls-ScreenUpdating-On  (*xlapp*)
  (vlax-put-property *xlapp* 'ScreenUpdating -1))
(Defun hyxls-cellid-calc (id x y / idx) ;;;計算范圍
  (setq   id  (car (hyxls-cellid id))
          idx (hyxls-rangeid id)
          x   (+ x (car idx))
          x   (if    (< x 1)
                1
                x)
          y   (+ y (cadr idx))
          y   (if    (< y 1)
                1
                y)
          idx (hyxls-rangeid (list x y))
          id  (hyxls-cellid (strcat id ":" idx))
          id  (strcat (car id) ":" (cadr id))
          )
  id
  )
(Defun hyxls-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
  )
(Defun hyxls-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 (hyxls-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 (hyxls-cellid-calc id xx yy))
      (msxl-put-value2
        (setq Rtn (msxl-get-range xl id))
        (vlax-safearray-fill ary data)
        )
      )
    )
  Rtn
  )
;;;首先定義完子函數..進入主函數階段
(Defun C:SPLL()
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(PrinC "\n該程序是對 Spline 進行數據分析的基本程序...")
(setq pen(car(entsel "\n指定一? Spline: ")))
(While
(/= "SPLINE"(cdr(assoc 0 (entget pen))))
(Alert "所指對象不是 Spline，請重新指定...")
(setq pen(car(entsel "\n重新指定一條 Spline: ")))
)

(setq pt1(getpoint  "n\選擇原點："))
(setq a1(car pt1))
(setq a2(cadr pt1))
(setq ent(entget pen))
(setq ct 0)
(textscr)
(setq informa nil)
(princ"\n 擬合的坐標值:")
(setq c1(length ent))
(while(< ct c1)
(setq d2(car(nth ct ent)))
(if (or (= 10 d2) (= 11 d2))
(progn
(setq d3(cdr(nth ct ent)))
(setq b1(car d3))
(setq b2(cadr d3))
(setq b1(- b1 a1))
(setq b2(- b2 a2))
(setq informa (cons (strcat "(" (rtos b1 2 3)  " " (rtos b2 2 3) ")") informa))
(print b1)
(print b2)
)
)
(setq ct(+ 1 ct))
)
(hyxls-app-Init) ;;;開始調用子程序
(setq xlapp (hyxls-app-New  t))
(hyxls-put-row-value xlapp "A1" informa nil)
(hyxls-ScreenUpdating-On xlapp)
(prin1)
)

lxz0929

我运行了，但是好象在EXCEL中并没有数据在上面输出！
另外我原来的思想是想通过用户的输入，从而获得”这是一条：“的文字，并且把这些文字在EXCEL 中输出，不知我这个想法能不能实现？！

舟自横

可以實現，自己領悟一下，很簡單的。。上面的貼已經更正過，可以運行。。

lxz0929

我现在调试时，在于下面的程序中红颜色的地方报错，说是参数类型错误，我看不懂，麻烦看看！

defun DSX-TypeLib-Excel ( / sysdrv tlb)
(setq sysdrv (getenv "systemdrive"))
(cond
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel8.olb")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel9.olb")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel10.olb")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office\\Excel.exe")))
tlb
)
( (setq tlb (findfile (strcat sysdrv "\\Program Files\\Microsoft Office\\Office11\\Excel.exe")))
tlb
)
)
)
(defun DSX-Load-TypeLib-Excel ( / tlbfile tlbver out)
(cond
( (null msxl-xl24HourClock)
(if (setq tlbfile (DSX-TypeLib-Excel))
(progn
(setq tlbver (substr (vl-filename-base tlbfile) 6))
(cond
( (= tlbver "9")
(princ "\n初始化 Microsoft Excel 2000...") )
( (= tlbver "8")
(princ "\n初始化 Microsoft Excel 97...") )
( (= (vl-filename-base tlbfile) "Excel.exe")
(princ "\n初始化 Microsoft Excel 2003...")
)
)
(vlax-import-type-library
:tlb-filename tlbfile
:methods-prefix "msxl-"
:properties-prefix "msxl-"
:constants-prefix "msxl-"
)
(if msxl-xl24HourClock (setq out T))
)
)
)
( T (setq out T) )
)
out
)
(defun DSX-Open-Excel-New (/ appsession)
(princ "\n创建一个新的 Excel 电子表格文件...")
(cond
( (setq appsession (vlax-create-object "Excel.Application"))
(vlax-invoke-method (vlax-get-property appsession 'WorkBooks) 'Add)
(if(equal (strcase dmode) "SHOW")

(vla-put-visible appsession 1)
(vla-put-visible appsession 0)
)
)
)appsession
)
(defun DSX-Excel-Put-RowList (lst startrow startcol)
(foreach itm lst
(msxl-put-value
(DSX-Excel-Get-Cell range startrow startcol)
itm
)
(setq startcol (1+ startcol))
)
)
(Defun C:SPLL()
       (PrinC "\n这是对 Spline 进行数据分析的基本程序...")
       (While(progn(setq pen(car(entsel "\n指定一条 Spline: ")))
                        (/= "SPLINE"(cdr(assoc 0 (entget pen))))
                )
                (Alert "所指对象不是 Spline，请重新指定...")
       )
  (princ "\这是一条：")
  (setq s (getstring))
  (princ "\请选择原点：")
  (setq pt1(getpoint))
  (print pt1)
  (setq a1(car pt1))
  (setq a2(cadr pt1))
  (setq ent(entget pen))
  (setq ct 0)
  (textpage)
  (princ"\n 拟合点的坐标值:")
  (setq c1(length ent))
  (while(< ct c1)
   (setq d2(car(nth ct ent)))
      (if(= 10 d2)
(progn
   (setq d3(cdr(nth ct ent)))
   (setq b1(car d3))
   (setq b2(cadr d3))
   (setq b1(- b1 a1))
   (setq b1(abs b1))
   (setq b2(- b2 a2))
   (setq b2(abs b2))
   (print b1)
   (print b2)
   )
      )
   (setq ct(+ 1 ct))
  )
  (print)
  (vl-load-com)
  (DSX-TypeLib-Excel)
  (DSX-Load-TypeLib-Excel)
  (DSX-Open-Excel-New t)
  (setq xlapp1(DSX-Load-TypeLib-Excel t))
  (DSX-Excel-Put-RowList lst startrow startcol)
)

舟自横

看不到你所指的紅色地方。。。
錯誤不只是一個地方
1...缺少子程序DSX-Excel-Get-Cell
2..(DSX-Excel-Put-RowList lst startrow startcol)里面的參數沒有賦值
3..(setq xlapp1(DSX-Load-TypeLib-Excel t))參數t多余,并且這一句毫無意義..
4..子程序defun DSX-Open-Excel-New (/ appsession)
   應該有參數dmode ..(defun DSX-Open-Excel-New ( dmode / appsession)...

啵浪鼓

星老弟,你又在此独钓寒江雪啦,看来你的号是找回来了,恭喜!

狂刀

这样的讨论很好，多多益善

lxz0929

报错的就是在子程序DSX-Open-Excel-New (dmode/ appsession)上，具体语句是：
(if(equal (strcase dmode) "SHOW")

(vla-put-visible appsession 1)
(vla-put-visible appsession 0)
)
它报错

舟自横

問題就是出在dmode參數上面
調用時他不可以使用布爾量
應該是"show" 或者任何其他字符，
如果是"show"則顯示。。
你試一下(DSX-Open-Excel-New "show")

fools

楼主提到：“。。。VLAX-DUMP-OBJECT函數去查詢然后對照他所有的功能用VLAX-GET-PROPERTY和VLAX-PUT-PROPERTY兩個功能基本上都可以實現屬性的編輯。”
请教：通过VLAX-DUMP-OBJECT函數还可以返回与object相关的方法，如何知道需要哪些参数及这些方法的作用。