lidaxiu 发表于 2012-2-13 09:11 static/image/common/back.gif
我也来个类似演示！！！
这个功能强大太厉害了
都是高手啊。
严哥，明天有时间把这个完善一下，就是直接打开EXCEL的，还有，如果文字里面有括号，或者其他符号，用你给我定制的LISP，出现窜行现象！
本帖最后由 yjr111 于 2012-2-14 10:45 编辑
为什么任兵 发表于 2012-2-13 18:44 http://bbs.mjtd.com/static/image/common/back.gif
严哥，明天有时间把这个完善一下，就是直接打开EXCEL的，还有，如果文字里面有括号，或者其他符号，用你给我 ...
上次excel就没研究出什么名堂，这次也没有研究出什么名堂，但从论坛的帖子里搞到了一点代码，然后加点料酒、大蒜就端出来献丑了。。。。
(DEFUN C:TJWB(/ N SSSTR_LST LST_STR STR1 SHUL STRLST )
(defun initexcel ()
(setq appxls (vlax-get-or-create-object "excel.application")
xlsworkbooks (vlax-get-property appxls "workbooks")
newbook (vlax-invoke-method xlsworkbooks "add")
newsheet (vlax-get-property newbook "sheets")
newitem (vlax-get-property newsheet "item" 1)
xlscells (vlax-get-property newitem "cells")
)
(vla-put-visible appxls :vlax-true)
)
(defun endexcel ()
(vlax-release-object xlscells)
(vlax-release-object newitem)
(vlax-release-object newsheet)
(vlax-release-object newbook)
(vlax-release-object xlsworkbooks)
(vlax-release-object appxls)
)
(defun datacell (nurow col value)
(vlax-put-property xlscells "item" numrow col (vl-princ-to-string value))
)
(VL-LOAD-COM)
(SETQ SS(SSGET '((0 . "*TEXT"))))
(SETQ N 0)
(WHILE (< N (SSLENGTH SS))
(SETQ LST_STR (APPEND LST_STR (LIST(CDR(ASSOC 1 (ENTGET (SSNAME SS N)))))))
(SETQ N (1+ N))
)
(SETQ LST_STR (vl-sort LST_STR(function(lambda(x y) (<x y)))))
(SETQ STRLSTLEN (LENGTH LST_STR))
(WHILE LST_STR
(SETQ SHUL(-STRLSTLEN(LENGTH(SETQ LST_STR(VL-REMOVE (SETQ STR1 (CAR LST_STR))LST_STR)))))
(SETQ STRLST (APPEND STRLST (LIST(LIST STR1 SHUL))))
(SETQ STRLSTLEN (LENGTH LST_STR))
)
(SETQ STRLST (append (list (list "编号" "数量(个)"))STRLST ))
(initexcel)
(setq numrow 1 )
(setq i 0)
(repeat (length STRLST)
(SETQ txt (nth iSTRLST))
(datacell numrow (setq numcol 1) (car txt))
(datacell numrow (setq numcol 2) (cadr txt))
(setq i (1+ i) numrow (1+ numrow) )
)
(endexcel)
(princ)
)
为什么任兵 发表于 2012-2-13 18:44 static/image/common/back.gif
严哥，明天有时间把这个完善一下，就是直接打开EXCEL的，还有，如果文字里面有括号，或者其他符号，用你给我 ...
我试了一下 怎么出现(警告! 程序已经退出!)
本帖最后由 lidaxiu 于 2012-2-14 10:01 编辑
flytoday 发表于 2012-2-13 12:20 http://bbs.mjtd.com/static/image/common/back.gif
这个好哈哈~~`能提供下载不啊谢谢~
不好意思，简单的可以共享，我的这个不是vlisp编的，是VB编的！不只是统计文字这么单一！当时参照 的是以前的豪典工具箱！
我的文字替换程序稍加改动就可以实现这个功能
lidaxiu 发表于 2012-2-13 09:11 static/image/common/back.gif
我也来个类似演示！！！
楼主好程序 能提供下载吗
非常感谢 yjr111 大师分享源码！
感谢yjr111 ，谢谢提供给大家