能帮忙把导出Excel改成导出WPS吗，搞了好久没搞好

szhorse

nyistjz 发表于 2020-12-26 14:29
那你再试试另外的一个，如果还是不行，你得找一下，是不是自己电脑或者 CAD 哪里出问题了。

这个不错，CAD2014成功

szhorse

nyistjz 发表于 2020-12-25 12:32
试试这个，是否可以满足你的要求 。
导出后，默认程序打开，当然也可以是WPS

这个CAD2014也成功，默认office打开

yuanziyou

主要修改了这一句：(setq acBook (vlax-invoke bks 'add -4167));;-4167表示用模板新建
先测试一下ok不ok啊？

1. (defun Mtext2Lstr (en / e lstr)
   
2.   (setq en(entmakex(entget en)))
   
3.   (setvar "cmdecho" 0)
   
4.   (command "_explode" en)
   
5.   (setvar "cmdecho" 0)
   
6.   (while
   
7.     (setq e(entnext en))
   
8.     (setq str(cdr(assoc 1(entget e))))
   
9.     (entdel e)
   
10.     (setq lstr(append Lstr(list str)))
    
11.   )
    
12. )
    
13. ;*************************
    
14. ;;;表快速输出 XLS
    
15. ;lst表一行一子表，一格一元素
    
16. ;(ls2xls (list (list "x" "y" 3)(list 1 "" 3)))
    
17. (defun ls2xls (lst / Excel:i2ColNo lens maxl x excel bks acBook sht rc cells range)
    
18.     (defun Excel:i2ColNo (a / l _i2ColNo)
    
19.     (defun _i2ColNo (num / lst)
    
20.       (cond((<= 1 num 26)(setq lst(cons num lst)))
    
21.         ((> num 26)(setq lst(append(_i2ColNo (/ num 26))(list(rem num 26)))))
    
22.         (t lst)
    
23.       ) lst
    
24.     )
    
25.     (if (and(>= (setq a(fix(abs a)))1)(setq l(_i2ColNo a)))
    
26.       (apply 'strcat(mapcar '(lambda (x)(chr(+ 64 x)))l))
    
27.     )
    
28.   );整数转EXCEL的列编号
    
29.   (setq lens(mapcar 'length lst))
    
30.   (setq maxl(apply 'max lens))
    
31.   (if        (not(apply '= lens))
    
32.     (setq lst(mapcar '(lambda(x)
    
33.                 (repeat(- maxl(length x))(setq x(append x(list "")))) x)lst)
    
34.     );子表不等长的用""补齐
    
35.   )  
    
36.   
    
37.   (setq excel (vlax-get-or-create-object "ket.Application"));;wps  
    
38.   ;(setq excel (vlax-get-or-create-object "Excel.Application"));;excle
    
39.   (vla-put-visible excel :vlax-true)
    
40.   (setq lens(length lst));行数
    
41.   (setq bks (vlax-get-property excel 'Workbooks))  
    
42.   (setq acBook (vlax-invoke bks 'add -4167));;-4167表示用模板新建
    
43.   (setq sht  (vlax-get-property acBook 'ActiveSheet))  
    
44.   (setq rc   (strcat "A1:"(excel:i2ColNo maxl)(itoa lens)));写表范围
    
45.   (setq range(vlax-get-property sht 'Range rc))
    
46.   (vlax-put-property range  'value2
    
47.     (vlax-safearray-fill
    
48.       (vlax-make-safearray vlax-vbstring
    
49.         (cons 1 lens)(cons 1(length (car lst)))
    
50.       )lst
    
51.     )
    
52.   )
    
53.   ;(vlax-put-property (vlax-get-property sht "Range" "A:A") "ColumnWidth" 20);列宽20
    
54.   ;(vlax-put-property (vlax-get-property sht "Range" "1:1") "RowHeight" 30);行高30
    
55. )
    
56. 
    
57. ;**************************************
    
58. (vl-load-com)
    
59. (defun c:mt2xls( / ss en lstr)
    
60.   (and(setq ss(ssget  '((0 . "mtext"))))
    
61.     (setq ss(vl-remove-if 'listp(mapcar 'cadr (ssnamex ss))))
    
62.     (foreach en ss
    
63.       (setq lstr(append lstr(list(Mtext2Lstr en))))
    
64.     )
    
65.     (ls2xls lstr)
    
66.   )
    
67.   (princ)
    
68. )
    

(defun Mtext2Lstr (en / e lstr)<br />   (setq en(entmakex(entget en)))<br />   (setvar "cmdecho" 0)<br />   (command "_explode" en)<br />   (setvar "cmdecho" 0)<br />   (while<br />     (setq e(entnext en))<br />     (setq str(cdr(assoc 1(entget e))))<br />     (entdel e)<br />     (setq lstr(append Lstr(list str)))<br />   )<br /> )<br /> ;*************************<br /> ;;;表快速输出 XLS<br /> ;lst表一行一子表，一格一元素<br /> ;(ls2xls (list (list "x" "y" 3)(list 1 "" 3)))<br /> (defun ls2xls (lst / Excel:i2ColNo lens maxl x excel bks acBook sht rc cells range)<br />     (defun Excel:i2ColNo (a / l _i2ColNo)<br />     (defun _i2ColNo (num / lst)<br />       (cond((<= 1 num 26)(setq lst(cons num lst)))<br />         ((> num 26)(setq lst(append(_i2ColNo (/ num 26))(list(rem num 26)))))<br />         (t lst)<br />       ) lst<br />     )<br />     (if (and(>= (setq a(fix(abs a)))1)(setq l(_i2ColNo a)))<br />       (apply 'strcat(mapcar '(lambda (x)(chr(+ 64 x)))l))<br />     )<br />   );整数转EXCEL的列编号<br />   (setq lens(mapcar 'length lst))<br />   (setq maxl(apply 'max lens))<br />   (if        (not(apply '= lens))<br />     (setq lst(mapcar '(lambda(x)<br />                 (repeat(- maxl(length x))(setq x(append x(list "")))) x)lst)<br />     );子表不等长的用""补齐<br />   )  <br />   <br />   (setq excel (vlax-get-or-create-object "ket.Application"));;wps  <br />   ;(setq excel (vlax-get-or-create-object "Excel.Application"));;excle<br />   (vla-put-visible excel :vlax-true)<br />   (setq lens(length lst));行数<br />   (setq bks (vlax-get-property excel 'Workbooks))  <br />   (setq acBook (vlax-invoke bks 'add -4167));;-4167表示用模板新建<br />   (setq sht  (vlax-get-property acBook 'ActiveSheet))  <br />   (setq rc   (strcat "A1:"(excel:i2ColNo maxl)(itoa lens)));写表范围<br />   (setq range(vlax-get-property sht 'Range rc))<br />   (vlax-put-property range  'value2<br />     (vlax-safearray-fill<br />       (vlax-make-safearray vlax-vbstring<br />         (cons 1 lens)(cons 1(length (car lst)))<br />       )lst<br />     )<br />   )<br />   ;(vlax-put-property (vlax-get-property sht "Range" "A:A") "ColumnWidth" 20);列宽20<br />   ;(vlax-put-property (vlax-get-property sht "Range" "1:1") "RowHeight" 30);行高30<br /> )<br /> <br /> ;**************************************<br /> (vl-load-com)<br /> (defun c:mt2xls( / ss en lstr)<br />   (and(setq ss(ssget  '((0 . "mtext"))))<br />     (setq ss(vl-remove-if 'listp(mapcar 'cadr (ssnamex ss))))<br />     (foreach en ss<br />       (setq lstr(append lstr(list(Mtext2Lstr en))))<br />     )<br />     (ls2xls lstr)<br />   )<br />   (princ)<br /> )<br />

wgij007

yuanziyou 发表于 2021-1-4 21:15
主要修改了这一句：(setq acBook (vlax-invoke bks 'add -4167));;-4167表示用模板新建
先测试一下ok不ok ...

不行呀,还是谢谢

wgij007

顶一下，看能不能有帮忙解决的

shutiao

MARK MARK  MARK