一只傲娇喵 发表于 2024-2-28 15:40:51

lisp如何导出excel

批量提取图纸文字后需要将文字导出到excel中，现有一段代码是每次运行新建一个sheet，现在想不新建，而是在默认打开的那个sheet的最后追加，这种可以实现吗


现有代码如下

<div>;;函数： (List_Save_Excel List)
;;功能： 将表数据输出到Excel (新建工作表)
;;参数： List 表，可以是一维或者二维表，或任意 list 表数据
;;返回： 0
;;示例： (List_Save_Excel '(1 2 3))
(defun List_Save_Excel( Lit / GetPy PutPy wbs wb sht xcells d c r)
(setq *appxls* (vlax-get-or-create-object "excel.application"))
(setq GetPy vlax-get-property PutPy vlax-put-property)
(setq wbs (GetPy *appxls* 'Workbooks))
;;判断工作薄（集合）是否为空，若空则新建工作簿，并返回工作薄指针
(setq wb (if (= 0 (GetPy wbs 'count))
    (vlax-invoke-method wbs 'add)
    (GetPy wbs 'item 1)) ;;如果不为空则返回第一个工作薄
)
;;新建工作表，用于导出数据。 (GetPy wb 'sheets) 是工作表集合对象
(setq sht (vlax-invoke-method (GetPy wb 'sheets) 'add))
;;得到工作表的 cells 对象，该对象与 range 对象的区别就是可以用行列定位
(setq xcells (GetPy sht 'cells) r 0 c 0)
(if (= (type Lit) 'LIST)
(repeat (length Lit)
    (setq d (nth r Lit) r (1+ r))
    (if (= (type d) 'LIST)
      (repeat (length d) (PutPy xcells 'item r (1+ c)(vl-princ-to-string(nth c d))) (setq c (1+ c)) )
    (PutPy xcells 'item 1 r (vl-princ-to-string d))
    )
    (setq c 0)
)(PutPy xcells 'item 1 1 (vl-princ-to-string Lit))
)
(vla-put-visible *appxls* 1);;显示工作表
;; 保存工作簿为文件
;(vla-saveas wb "C:/Test.xlsx")
(vlax-release-object xcells);;用完销毁
(vlax-release-object sht)
(vlax-release-object *appxls*)
)</div>


MXS 发表于 2024-3-1 09:16:18

一只傲娇喵 发表于 2024-2-29 09:01
看了看发现还是每次运行都新建一个工作表呀，大佬有无在当前工作表追加数据的代码

去看看@lisp的函数库，那里面的excel部分有你可以用到的函数

一只傲娇喵 发表于 2024-2-29 10:22:51

研究了一下，好像自己改好了，不新建sheet而是追加

(defun List_Save_Excel2( Lit / GetPy PutPy wbs wb sht xcells d c r)
(setq *appxls* (vlax-get-or-create-object "excel.application"))
(setq GetPy vlax-get-property PutPy vlax-put-property)
(setq wbs (GetPy *appxls* 'Workbooks))
(setq init nil)
;;判断工作薄（集合）是否为空，若空则新建工作簿，并返回工作薄指针
(setq wb (if (= 0 (GetPy wbs 'count))
           (progn
                (vlax-invoke-method wbs 'add)
                     (setq init 1)
             )
    (GetPy wbs 'item 1)) ;;如果不为空则返回第一个工作薄
)
;;新建工作表，用于导出数据。 (GetPy wb 'sheets) 是工作表集合对象
;(setq sht (vlax-invoke-method (GetPy wb 'sheets) 'add))
(setq sht (vlax-get-property *appxls* 'ActiveSheet))
(setq Rtn (vlax-get-property sht "UsedRange" ))
(setq row_count (vlax-get (vlax-get Rtn 'Rows) 'Count))
;(princ row_count)
(if (= 1 init)
    (setq row_count 0)
    )
;;得到工作表的 cells 对象，该对象与 range 对象的区别就是可以用行列定位
(setq xcells (GetPy sht 'cells) r row_count c 0 ind 0)
(if (= (type Lit) 'LIST)
(repeat (length Lit)
    (setq d (nth ind Lit) r (1+ r) ind (1+ ind))
    (if (= (type d) 'LIST)
      (progn
        (repeat (length d) (PutPy xcells 'item r (1+ c)(vl-princ-to-string(nth c d))) (setq c (1+ c)))
        )
      
    (PutPy xcells 'item (+ 1 (- r ind)) ind (vl-princ-to-string d))
    )
    (setq c 0)
)(PutPy xcells 'item 1 r (vl-princ-to-string Lit))
)
(vla-put-visible *appxls* 1);;显示工作表
;; 保存工作簿为文件
;(vla-saveas wb "C:/Test.xlsx")
(vlax-release-object xcells);;用完销毁
(vlax-release-object sht)
(vlax-release-object *appxls*)
)

咏郡 发表于 2024-2-28 17:46:28

我这码我也用过，忘记了出处了

咏郡 发表于 2024-2-28 17:56:38

本帖最后由 咏郡 于 2024-5-9 17:59 编辑

我这个就是改编后的，为了以后我下载代码收了1个币，

jun470 发表于 2024-2-28 21:29:10

咏郡 发表于 2024-2-28 17:56
我这个就是改编后的，为了以后我下载代码收了1个币

这个程序完整吗？

一只傲娇喵 发表于 2024-2-29 09:01:29

咏郡 发表于 2024-2-28 17:56
我这个就是改编后的，为了以后我下载代码收了1个币

看了看发现还是每次运行都新建一个工作表呀，大佬有无在当前工作表追加数据的代码

伊江痕 发表于 2024-2-29 21:40:02

学到了，感谢分享

Qwer1243 发表于 2024-4-29 15:54:19

感谢分享，提供了很好的思路

wy_zy 发表于 2024-5-9 10:31:31

咏郡 发表于 2024-2-28 17:56
我这个就是改编后的，为了以后我下载代码收了1个币

大佬，请教下为啥我下载之后加载成功运行K2命令启动了，但是后来加载成功，运行K2变成未知指令了，求教，谢谢
页: [1] 2
查看完整版本: lisp如何导出excel