[转贴]：我来转贴一个acad和excel数据转换的函数

zero · 发表于 2003-2-16 23:12:24

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

这是某外国大虾写的转换函数，大家试试。
不过要先把其中的dsx-princ全部改成princ。

<normalfont>
;;;*************************************************************************;;;
;;; 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")
)
(princ)
</normalfont>

<normalfont> 
 
 
;;;*************************************************************************;;; 
;;; 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") 
) 
 
(princ) 
 
</normalfont>

鹰博长空 · 发表于 2003-5-15 17:47:05

可不可以根据理解，加些中文注释以饷如我等菜鸟？

LUCAS · 发表于 2003-5-16 07:57:59

明經通道有中文註釋

pandoit · 发表于 2003-5-16 08:32:39

好东东，不过我等菜鸟看不懂，也不知如何用也！

succeed · 发表于 2003-5-20 13:52:26

有些地方看不懂，看来功力不够。

账号		自动登录	找回密码
密码			立即注册

[转贴]：我来转贴一个acad和excel数据转换的函数

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子