有一想法，不知能不能做到

wgij007

有一想法，不知能不能做到。
框选多行文字，（一般有4行）。确定后，每个多行文字为一行排列。最后全部输出到Excel.


以下是由wzg356大师完成的代码:
(defun Mtext2Lstr (en / e lstr)
        (setq en(entmakex(entget en)))
        (setvar "cmdecho" 0)
        (command "_explode" en)
        (setvar "cmdecho" 0)
        (while
                (setq e(entnext en))
                (setq str(cdr(assoc 1(entget e))))
                (entdel e)
                (setq lstr(append Lstr(list str)))
        )
)
;*************************
;;;表快速输出 XLS
;lst表一行一子表，一格一元素
;(ls2xls (list (list "x" "y" 3)(list 1 "" 3)))
(defun ls2xls (lst / Excel:i2ColNo lens maxl x excel bks acBook sht rc cells range)
    (defun Excel:i2ColNo (a / l _i2ColNo)
            (defun _i2ColNo (num / lst)
                    (cond((<= 1 num 26)(setq lst(cons num lst)))
                            ((> num 26)(setq lst(append(_i2ColNo (/ num 26))(list(rem num 26)))))
                            (t lst)
                        ) lst
                )
                (if (and(>= (setq a(fix(abs a)))1)(setq l(_i2ColNo a)))
                        (apply 'strcat(mapcar '(lambda (x)(chr(+ 64 x)))l))
                )
        );整数转EXCEL的列编号
        (setq lens(mapcar 'length lst))
        (setq maxl(apply 'max lens))
        (if        (not(apply '= lens))
                (setq lst(mapcar '(lambda(x)
                        (repeat(- maxl(length x))(setq x(append x(list "")))) x)lst)
                );子表不等长的用""补齐
        )
        (setq excel (vlax-get-or-create-object "Excel.Application"))
        (vla-put-visible excel :vlax-true)
        (setq lens(length lst));行数
        (setq bks (vlax-get excel 'workbooks))
        (setq acBook(vlax-invoke bks 'Add))
        (setq sht  (vlax-get excel 'ActiveSheet))
        (setq rc   (strcat "A1:"(excel:i2ColNo maxl)(itoa lens)));写表范围
        (setq cells(vlax-get sht 'cells))
        (setq range(vlax-get-property cells 'Range rc))
        (vlax-put-property range  'value2
                (vlax-safearray-fill
                        (vlax-make-safearray vlax-vbstring
                                (cons 1 lens)(cons 1(length (car lst)))
                        )lst
                )
        )
        ;(vlax-put-property (vlax-get-property sht "Range" "A:A") "ColumnWidth" 20);列宽20
        ;(vlax-put-property (vlax-get-property sht "Range" "1:1") "RowHeight" 30);行高30
)

;**************************************
(vl-load-com)
(defun c:mt2xls( / ss en lstr)
        (and(setq ss(ssget  '((0 . "mtext"))))
                (setq ss(vl-remove-if 'listp(mapcar 'cadr (ssnamex ss))))
                (foreach en ss
                        (setq lstr(append lstr(list(Mtext2Lstr en))))
                )
                (ls2xls lstr)
        )
        (princ)
)

wzg356

加载18/23楼函数

(defun c:mt2xls( / ss en lstr)
        (and(setq ss(ssget  '((0 . "mtext"))))
                (setq ss(vl-remove-if 'listp(mapcar 'cadr (ssnamex ss))))
                (foreach en ss
                        (setq lstr(append lstr(list(Mtext2Lstr en))))
                )
                (ls2xls lstr)
        )
        (princ)
)

革天明

这个功能还是比较简单的，可加我或发个dwg

wgij007

革天明 发表于 2020-12-3 08:56
这个功能还是比较简单的，可加我或发个dwg

如能做的话真的太感谢了。

mikewolf2k

这不是太简单了么，获取Mtext文本，在Excel中按照换行符分列。

wgij007

mikewolf2k 发表于 2020-12-4 09:31
这不是太简单了么，获取Mtext文本，在Excel中按照换行符分列。

能帮忙做一下吗

wgij007

顶一下，各位大神

wgij007

顶一下

xvjiex

可能你没注意，或没有明白，2楼让你上传CAD文档，根据你的CAD文档帮你做。

wgij007

抱歉，没留意。