悬赏文字统计

lizhiqiang9801

lidaxiu 发表于 2012-2-13 09:11
我也来个类似演示！！！

这个功能强大  太厉害了

13579

都是高手啊。

为什么任兵

严哥，明天有时间把这个完善一下，就是直接打开EXCEL的，还有，如果文字里面有括号，或者其他符号，用你给我定制的LISP，出现窜行现象！

yjr111

为什么任兵 发表于 2012-2-13 18:44
严哥，明天有时间把这个完善一下，就是直接打开EXCEL的，还有，如果文字里面有括号，或者其他符号，用你给我 ...

上次excel就没研究出什么名堂，这次也没有研究出什么名堂，但从论坛的帖子里搞到了一点代码，然后加点料酒、大蒜就端出来献丑了。。。。
(DEFUN C:TJWB(/ N SS  STR_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 i  STRLST))
(datacell numrow (setq numcol 1) (car txt))
(datacell numrow (setq numcol 2) (cadr txt))
(setq i (1+ i) numrow (1+ numrow) )      
)
(endexcel)
(princ)
  )

lizhiqiang9801

为什么任兵 发表于 2012-2-13 18:44
严哥，明天有时间把这个完善一下，就是直接打开EXCEL的，还有，如果文字里面有括号，或者其他符号，用你给我 ...

我试了一下 怎么出现(警告! 程序已经退出!)

lidaxiu

flytoday 发表于 2012-2-13 12:20
这个好哈哈~~`能提供下载不啊谢谢~

不好意思，简单的可以共享，我的这个不是vlisp编的，是VB编的！不只是统计文字这么单一！当时参照 的是以前的豪典工具箱！

cabinsummer

我的文字替换程序稍加改动就可以实现这个功能

微~妙

lidaxiu 发表于 2012-2-13 09:11
我也来个类似演示！！！

楼主好程序 能提供下载吗

669423907

非常感谢 yjr111 大师分享源码！

夜精灵

感谢yjr111 ，谢谢提供给大家