[LISP程序]：lisp程序中读取excel表中数据的解决办法

wangxi28

本人是个AUTOLISP新手，是做市政设计的，工作之余也编了一些LISP的小程序，但也仅仅是用于自已的做图中，不具有多少通用性。在使用这些小程序时，有很多时候需要从EXCEL中读入数据，而我也只能是使用复制>粘贴的方法，太过笨拙。对这个问题，一直没有好的办法解决，想请教各位LISP高手帮助一下，不胜感激。

lsjjm

Excel v AutoCAD数据转换
Reference:  www.acadx.com
                    www.dsxcad.com.

wangxi28

你好，我在你提供的网站上找不到所要的东西啊

lsjjm

程序码之前半部:
;;;*************************************************************************;;;
;;; DSX-API-Excel.LSP                                                       ;;;
;;; Visual LISP ActiveX API for Excel 97, 2000 and XP                       ;;;
;;; Copyright (C)2002 David M. Stein, All rights reserved                   ;;;
;;;*************************************************************************;;;
;;; Version 2002.22 05/15/02: Initial release                               ;;;
;;;*************************************************************************;;;
;;; Code provided AS-IS without warranty of any kind given for any purpose  ;;;
;;; or use, either explicitly, implicitly or as a derivative work item.     ;;;
;;; User assumes ANY AND ALL RISK and LIABILITY for use of any of this code ;;;
;;; for any consequential damages of any kind.  These functions are defined ;;;
;;; within DSX Tools 2002.22 when loaded into AutoCAD.  This document is    ;;;
;;; provided for informational purposes only.                               ;;;
;;;*************************************************************************;;;

(vl-load-com)

;;;*************************************************************************
;;; MODULE: DSX-TypeLib-Excel
;;; DESCRIPTION: Returns typelib (olb) file for either Excel 97, 2000, or XP
;;; ARGS: none
;;; EXAMPLE: (DSX-TypeLib-Excel)
;;;*************************************************************************

(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\\Office10\\Excel.exe")))
                  tlb
                )
        )
)
                  
;;;*************************************************************************
;;; MODULE: DSX-Load-TypeLib-Excel
;;; DESCRIPTION: Loads typelib for Excel 97, 2000 or XP (whichever is found)
;;; ARGS: none
;;; EXAMPLE: (DSX-Load-TypeLib-Excel)
;;;*************************************************************************

(defun DSX-Load-TypeLib-Excel ( / tlbfile tlbver out)
  (dsx-princ "\n(DSX-Load-TypeLib-Excel)")
  (cond
    ( (null msxl-xl24HourClock)
      (if (setq tlbfile (DSX-TypeLib-Excel))
        (progn
                                        (setq tlbver (substr (vl-filename-base tlbfile) 6))
                                        (cond
                                                ( (= tlbver "9")  (princ "\nInitializing Microsoft Excel 2000...") )
                                                ( (= tlbver "8")  (princ "\nInitializing Microsoft Excel 97...") )
                                                ( (= (vl-filename-base tlbfile) "Excel.exe")
                                                         (princ "\nInitializing Microsoft Excel XP...")
                                                )
                                        )
                      (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
)

;;;*************************************************************************
;;; MODULE: DSX-Open-Excel-New
;;; DESCRIPTION: Opens a new session of Excel 97, 2000 or XP
;;; ARGS: display-mode ("SHOW" or "HIDE")
;;; EXAMPLE: (setq xlapp (DSX-Open-Excel-New "SHOW"))
;;;*************************************************************************

(defun DSX-Open-Excel-New (dmode / appsession)
  (dsx-princ "\n(DSX-Open-Excel-New)")
        (princ "\nCreating new Excel Spreadsheet file...")
        (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
)

;;;*************************************************************************
;;; MODULE: DSX-Open-Excel-Exist
;;; DESCRIPTION: Gets handle to existing (running) session of Excel 97, 2000, XP
;;; ARGS: xls-filename, display-mode ("SHOW" or "HIDE")
;;; EXAMPLE: (setq xlapp (DSX-Open-Excel-Exist "myfile.xls" "SHOW"))
;;;*************************************************************************

(defun DSX-Open-Excel-Exist (xfile dmode / appsession)
  (dsx-princ "\n(DSX-Open-Excel-Exist)")
        (princ "\nOpening Excel Spreadsheet file...")
  (cond
                ( (setq fn (findfile xfile))
                        (cond
                                ( (setq appsession (vlax-get-or-create-object "Excel.Application"))
                      (vlax-invoke-method
                        (vlax-get-property appsession 'WorkBooks)
                        'Open fn
                      )
                                  (if (= (strcase dmode) "SHOW")
                                          (vla-put-visible appsession 1)
                                                (vla-put-visible appsession 0)
                                        )
                                )
                        )
          )
                ( T (alert (strcat "\nCannot locate source file: " xfile)) )
  )
        appsession
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-Put-ColumnList
;;; DESCRIPTION: Write each list member to a column (startcol) starting at row (startrow)
;;; ARGS: list, startrow, startcol
;;; EXAMPLE: (DSX-Excel-Put-ColumnList '("A" "B" "C") 1 2) puts members into cells (1,B) (2,B) (3,B) respectively
;;;*************************************************************************

(defun DSX-Excel-Put-ColumnList (lst startrow startcol)
  (dsx-princ "\n(DSX-Excel-Put-ColumnList)")
  (foreach itm lst
    (msxl-put-value
      (DSX-Excel-Get-Cell range startrow startcol)
      itm
    )
    (setq startrow (1+ startrow))
  ); repeat
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-Put-RowList
;;; DESCRIPTION: Write each list member to row (startrow) starting at column (startcol)
;;; ARGS: list, startrow, startcol
;;; EXAMPLE: (DSX-Excel-Put-RowList '("A" "B" "C") 2 1) puts members into cells (1,B) (1,C) (1,D) respectively
;;;*************************************************************************

(defun DSX-Excel-Put-RowList (lst startrow startcol)
  (dsx-princ "\n(DSX-Excel-Put-RowList)")
  (foreach itm lst
    (msxl-put-value
      (DSX-Excel-Get-Cell range startrow startcol)
      itm
    )
    (setq startcol (1+ startcol))
  ); repeat
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-Put-CellColor
;;; DESCRIPTION: Applies fill-color to specified cell
;;; ARGS: row, column, color (integer)
;;; EXAMPLE: (DSX-Excel-Put-CellColor 1 1 14) apply color #14 to cell (1,A)
;;;*************************************************************************

(defun DSX-Excel-Put-CellColor (row col intcol / rng)
  (setq rng (DSX-Excel-Get-Cell (msxl-get-ActiveSheet xlapp) row col))
  (msxl-put-colorindex (msxl-get-interior rng) intcol)
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-Put-RowCellsColor
;;; DESCRIPTION: Applies fill-color to a row of cells
;;; ARGS: startrow, startcol, num-cols, color (integer)
;;; EXAMPLE: (DSX-Excel-Put-RowCellsColor 1 1 5 14) Start at row=1 col=1 repeat for 5 columns using color #14
;;;*************************************************************************

(defun DSX-Excel-Put-RowCellsColor
        (startrow startcol cols intcol / next)
  (dsx-princ "\n(DSX-Excel-Put-RowCellsColor)")

  (setq next startcol)
  (repeat cols
    (DSX-Excel-Put-CellColor startrow next intcol)
    (setq next (1+ next))
  )
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-Put-ColumnCellsColor
;;; DESCRIPTION: Change fill color in a column of cells
;;; ARGS: startrow, startcol, num-rows, color (integer)
;;; EXAMPLE: (DSX-Excel-Put-ColumnCellsColor 1 1 5 14) Start at row=1 col=1 repeat for 5 rows using color #14
;;;*************************************************************************

(defun DSX-Excel-Put-ColumnCellsColor
        (startrow startcol rows intcol / next)
  (dsx-princ "\n(DSX-Excel-Put-ColumnCellsColor)")

  (setq next startrow)
  (repeat rows
    (DSX-Excel-Put-CellColor next startcol intcol)
    (setq next (1+ next))
  )
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-Get-Cell
;;; DESCRIPTION: Get cell object relative to range using (relrow) and (relcol) offsets
;;; ARGS: range-object, relative-row, relative-col
;;; EXAMPLE: (DSX-Excel-Get-Cell rng1 2 2)
;;;*************************************************************************

(defun DSX-Excel-Get-Cell (rng relrow relcol)
  (dsx-princ "\n(DSX-Excel-Get-Cell)")
  (vlax-variant-value
    (msxl-get-item (msxl-get-cells rng)
      (vlax-make-variant relrow)
      (vlax-make-variant relcol)
    )
  )
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-Get-CellValue
;;; DESCRIPTION: Return value in given cell (row, column) of active session object (xlapp)
;;; ARGS: row(int), column(int)
;;; EXAMPLE: (DSX-Excel-Get-CellValue 1 2)
;;;*************************************************************************

(defun DSX-Excel-Get-CellValue (row col)
  (dsx-princ "\n(DSX-Excel-Get-CellValue)")

  (vlax-variant-value
    (msxl-get-value
      (DSX-Excel-Get-Cell
        (msxl-get-ActiveSheet xlapp)
        row col
      )
    )
  )
)

程序码之后半部:
;;;*************************************************************************
;;; MODULE: DSX-Excel-Get-RowValues
;;; DESCRIPTION: Returns a list of cell values within a given row
;;; ARGS: row-number(int), startcol, num-cells
;;; EXAMPLE: (DSX-Excel-Get-RowValues 3 1 20) get first 20 values in row 3
;;;*************************************************************************

(defun DSX-Excel-Get-RowValues
        (row startcol numcells / next out)
  (dsx-princ "\n(DSX-Excel-Get-RowValues)")

        (setq next startcol)
        (repeat numcells
                (setq out                (if out
                  (append out (list (DSX-Excel-Get-CellValue row next))); row x col
                  (list (DSX-Excel-Get-CellValue row next)); row x col
                                                                )
                                        next         (1+ next)
                )
        ); repeat
        out
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-Get-ColumnValues
;;; DESCRIPTION: Returns a list of cell values within a given column
;;; ARGS: column-number(int), startrow, num-cells
;;; EXAMPLE: (DSX-Excel-Get-ColumnValues 2 1 20) get top-20 entries in column 2 ("B")
;;;*************************************************************************

(defun DSX-Excel-Get-ColumnValues
        (col startrow numcells / next out)
  (dsx-princ "\n(DSX-Excel-Get-ColumnValues)")

        (setq next startrow)
        (repeat numcells
                (setq out
                        (if out
        (append out (list (DSX-Excel-Get-CellValue next col)))
        (list (DSX-Excel-Get-CellValue next col))
                        )
                                        next (1+ next)
                )
        ); repeat
        out
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-GetRangeValues-ByRows
;;; DESCRIPTION: Get range values in row order and return as nested lists
;;; ARGS: startrow, startcol, num-rows, num-cols
;;; EXAMPLE: (DSX-Excel-GetRangeValues-ByRows 1 1 5 10) get range values from 1A to 5J where each sublist is one row
;;;*************************************************************************

(defun DSX-Excel-GetRangeValues-ByRows
        (startrow startcol numrows numcols / nextrow rowlst outlst)
  (dsx-princ "\n(DSX-Excel-GetRangeValues-ByRows)")
        (setq nextrow startrow)
        (repeat numrows
    (setq rowlst  (DSX-Excel-Get-RowValues nextrow startcol numcols)
                                        outlst  (if outlst (append outlst (list rowlst)) (list rowlst))
                                  nextrow (1+ nextrow)
                )
        )
        outlst
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-GetRangeValues-ByCols
;;; DESCRIPTION: Get range values in column order and return as nested lists
;;; ARGS: startrow, startcol, num-rows, num-cols
;;; EXAMPLE: (DSX-Excel-GetRangeValues-ByCols 1 1 5 10) get range values from 1A to 5J where each sublist is one column
;;;*************************************************************************

(defun DSX-Excel-GetRangeValues-ByCols
  (startrow startcol numrows numcols / nextrow nextcol collst outlst)
  (dsx-princ "\n(DSX-Excel-GetRangeValues-ByCols)")
        (setq nextcol startcol)
        (repeat numcols
    (setq collst  (DSX-Excel-Get-ColumnValues nextcol startrow numrows)
                                        outlst  (if outlst (append outlst (list collst)) (list collst))
                                  nextcol (1+ nextcol)
                )
        )
        outlst
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-Get-ActiveWorkSheet
;;; DESCRIPTION: Returns object of active worksheet in active Excel session
;;; ARGS: app (session object)
;;; EXAMPLE: (DSX-Excel-Get-ActiveWorkSheet xlapp)
;;;*************************************************************************

(defun DSX-Excel-Get-ActiveWorkSheet (xlapp)
  (dsx-princ "\n(DSX-Excel-Get-ActiveWorkSheet)")
        (msxl-get-ActiveSheet xlapp)
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-RangeAutoFit
;;; DESCRIPTION: Applies Auto-Fit to columns within active range
;;; ARGS: active-sheet (object)
;;; EXAMPLE: (DSX-Excel-RangeAutoFit myxlws)
;;;*************************************************************************

(defun DSX-Excel-RangeAutoFit (active-sheet)
        (dsx-princ "\n(DSX-Excel-RangeAutoFit)")
        (vlax-invoke-method
                (vlax-get-property
                        (vlax-get-property
                                (vlax-get-property active-sheet 'UsedRange)
                                'Cells
                        )
                        'Columns
                )
                'AutoFit
        )
)

(defun DSX-Excel-RangeDataFormat (active-sheet)
        (dsx-princ "\n(DSX-Excel-RangeDataFormat)")
        (vlax-put-property
                (vlax-get-property active-sheet "Cells")
                'NumberFormat "@"
        )
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-Quit
;;; DESCRIPTION: Quit and close Excel session (app)
;;; ARGS: app (session object)
;;; EXAMPLE: (DSX-Excel-Quit xlapp)
;;;*************************************************************************

(defun DSX-Excel-Quit (appsession)
  (dsx-princ "\n(DSX-Excel-Quit)")
        (cond
                ( (not (vlax-object-released-p appsession))
                        (vlax-invoke-method appsession 'QUIT)
                        (vlax-release-object appsession)
                )
        )
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-Kill
;;; DESCRIPTION: Forces any open Excel sessions to be closed
;;; ARGS: none
;;; EXAMPLE: (DSX-Excel-Kill)
;;;*************************************************************************

(defun DSX-Excel-Kill ( / eo)
        (while (setq eo (vlax-get-object "Excel.Application"))
                (DSX-Excel-Quit eo)
                (vlax-release-object eo)
                (setq eo nil)
                (gc)(gc);; even this doesn't always kill the damn thing!
  )
)

;;;*************************************************************************
;;; MODULE:
;;; DESCRIPTION:
;;; ARGS:
;;; EXAMPLE:
;;;*************************************************************************
;;; Remove trailing 'nil' members from a given list

(defun DSX-TrimList (lst)
        (cond
                ( (/= nil (last lst)) lst)
                ( T
      (DSX-TrimList (reverse (cdr (reverse lst))))
                )
        )
)

;;;*************************************************************************
;;; MODULE:
;;; DESCRIPTION:
;;; ARGS:
;;; EXAMPLE:
;;;*************************************************************************
;;; Convert a list of values into a list of string equivalents

(defun DSX-ListStr (lst / mbr out)
        (setq out '())
        (foreach mbr lst
                (cond
                        ( (= mbr nil) (setq out (cons "" out)) )
                        ( (= (type mbr) 'STR)
                          (if (member mbr '(" " "  " "   "))
                                        (setq out (cons "" out))
                                  (setq out (cons mbr out))
                                )
                        )
                        ( (= (type mbr) 'INT) (setq out (cons (itoa mbr) out)) )
                        ( (= (type mbr) 'REAL)(setq out (cons (rtos mbr 2 6) out)))
                )
        )
        (reverse out)
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-Sheets
;;; DESCRIPTION: Returns SHEETS collection from active workbook
;;; ARGS: Excel-application
;;; EXAMPLE: (setq sheets (DSX-Excel-Sheets xlApp))
;;;*************************************************************************

(defun DSX-Excel-Sheets (xlapp)
        (setq xlsheets         (vlax-get-property xlapp "sheets"))
)

;;;*************************************************************************
;;; MODULE:DSX-Excel-SheetDelete
;;; DESCRIPTION: Delete sheet (tab) from active workbook sheets collection
;;; ARG: sheet-name, sheets-collection
;;; EXAMPLE: (DSX-Excel-SheetDelete "Sheet3" xlSheets)
;;;*************************************************************************

(defun DSX-Excel-SheetDelete (name xlsheets)
        (vlax-for sh xlsheets
                (if (= (vlax-get-property sh "Name") name)
                        (vlax-invoke-method sh "Delete")
                )
        )
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-SheetAdd
;;; DESCRIPTION: Add new sheet (tab) to sheets collection in workbook, returns sheet object
;;; ARG: sheet-name, sheets-collection
;;; EXAMPLE: (setq newsheet (DSX-Excel-SheetAdd "SheetX" xlSheets))
;;;*************************************************************************

(defun DSX-Excel-SheetAdd (name xlsheets)
        (setq newsheet                 (vlax-invoke-method xlsheets "Add"))
        (vlax-put-property newsheet "Name" name)
        newsheet
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-WorkbookSave
;;; DESCRIPTION: Saves active workbook to specified filename, if file exists, it is overwritten if user accepts prompt
;;; ARG: workbook-object, filename
;;; EXAMPLE: (DSX-Excel-WorkbookSave objWB "myfile.xls")
;;;*************************************************************************

(defun DSX-Excel-WorkbookSave (workbook filename)
  (if (findfile filename)
                (vlax-invoke-method awb "Save")
                (vlax-invoke-method awb "SaveAs"
                        filename msxl-xlNormal "" ""
                        :vlax-False :vlax-False nil
                )
        )
)

;;;*************************************************************************
;;; MODULE: DSX-Excel-ActiveWorkbook
;;; DESCRIPTION: Returns active workbook object from given Excel application session
;;; ARG: Excel-application
;;; EXAMPLE: (setq objWB (DSX-Excel-ActiveWorkbook xlApp))
;;;*************************************************************************

(defun DSX-Excel-ActiveWorkbook (xlapp)
        (vlax-get-property xlapp "ActiveWorkbook")
)

mmmm

去http://www.ikozmos.com/download/oasis-xls.zip下载OASis-XLS Beta Evaluation
我刚刚传上去

wangxi28

非常感谢以上二位的贴子，我下来研究一下。


5楼好，我已下载并加载了OASis-XLS ，但在生成OTG时，出现如下ACAD信息：Application Erron; no function definition : MSXL-GET-ACTIVESHEET,是何原因啊？

lsj60912

我想要能切换到指定名称工作簿的指定名称的工作表中，有没有这样的函数？

mmmm

wangxi28:
试试先运行一下
(C:OAS_XLS_App-Initialize)
如果返回NIL，加载下列代码：（只需要一次就行了）
(setcfg "AppData/OASis-XLS/OfficeHost" "C:")
如果Office不在C盘,写入其所在的正确盘符。

lsjjm

7楼,看这:
(defun opensheet (xlfile sname)
  (setq Excl  (vlax-Get-or-Create-Object "Excel.Application"))
  (setq WorkBk (vlax-get Excl 'Workbooks))
  (setq xlapp (vlax-invoke-Method WorkBk 'Open xlfile))
  (vla-Put-Visible Excl 0)
  (setq sheets (vlax-get-property xlapp 'sheets))
  (vlax-for sh sheets
    (if (= (strcase (vlax-get-property sh 'Name))(strcase sname))(setq xsheet sh))
  );
  xsheet
);

wangxi28

非常感谢mmmm先生，在你的指导下，我已解决该问题

yxh1202

lsjjm 发表于 2003-9-1 17:08
7楼,看这:
(defun opensheet (xlfile sname)
  (setq Excl  (vlax-Get-or-Create-Object "Excel.Applicat ...

你好，我想不打开指定的工作薄，例如  纵断面.xls，有三个工作薄，名称分别是   表一，表二，表三。我想根据输入的工作表名称以及单元格名称来读取数据，例如  表二中的C16。来获得数据，请问怎么编写，求帮助