lisp如何导出excel

一只傲娇喵

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


现有代码如下

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

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

MXS

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

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

一只傲娇喵

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

1. (defun List_Save_Excel2( Lit / GetPy PutPy wbs wb sht xcells d c r)
   
2. (setq *appxls* (vlax-get-or-create-object "excel.application"))
   
3. (setq GetPy vlax-get-property PutPy vlax-put-property)
   
4. (setq wbs (GetPy *appxls* 'Workbooks))
   
5.   (setq init nil)
   
6. ;;判断工作薄（集合）是否为空，若空则新建工作簿，并返回工作薄指针
   
7. (setq wb (if (= 0 (GetPy wbs 'count))
   
8.            (progn
   
9.                 (vlax-invoke-method wbs 'add)
   
10.                      (setq init 1)
    
11.              )
    
12.     (GetPy wbs 'item 1)) ;;如果不为空则返回第一个工作薄
    
13. )
    
14. ;;新建工作表，用于导出数据。 (GetPy wb 'sheets) 是工作表集合对象
    
15. ;(setq sht (vlax-invoke-method (GetPy wb 'sheets) 'add))
    
16.   (setq sht (vlax-get-property *appxls* 'ActiveSheet))
    
17.   (setq Rtn (vlax-get-property sht "UsedRange" ))
    
18. (setq row_count (vlax-get (vlax-get Rtn 'Rows) 'Count))
    
19. ;(princ row_count)
    
20.   (if (= 1 init)
    
21.     (setq row_count 0)
    
22.     )
    
23. ;;得到工作表的 cells 对象，该对象与 range 对象的区别就是可以用行列定位
    
24. (setq xcells (GetPy sht 'cells) r row_count c 0 ind 0)
    
25. (if (= (type Lit) 'LIST)
    
26. (repeat (length Lit)
    
27.     (setq d (nth ind Lit) r (1+ r) ind (1+ ind))
    
28.     (if (= (type d) 'LIST)
    
29.       (progn
    
30.         (repeat (length d) (PutPy xcells 'item r (1+ c)(vl-princ-to-string(nth c d))) (setq c (1+ c)))
    
31.         )
    
32.         
    
33.     (PutPy xcells 'item (+ 1 (- r ind)) ind (vl-princ-to-string d))
    
34.     )
    
35.     (setq c 0)
    
36. )(PutPy xcells 'item 1 r (vl-princ-to-string Lit))
    
37. )
    
38. (vla-put-visible *appxls* 1)  ;;显示工作表
    
39.   ;; 保存工作簿为文件
    
40.   ;(vla-saveas wb "C:/Test.xlsx")
    
41. (vlax-release-object xcells)  ;;用完销毁
    
42. (vlax-release-object sht)
    
43. (vlax-release-object *appxls*)
    
44. )

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

咏郡

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

咏郡

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

jun470

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

这个程序完整吗？

一只傲娇喵

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

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

伊江痕

学到了，感谢分享

Qwer1243

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

wy_zy

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

大佬，请教下为啥我下载之后加载成功运行K2命令启动了，但是后来加载成功，运行K2变成未知指令了，求教，谢谢