LISP/VLISP程序

eachy

最初由 yecaiping 发布
[B]呵呵，还要配合其他程序太麻烦啦，我只想纯lisp的，不知道如何实现！ [/B]

你会多少？

yoyoho

eachy斑主:
统计文字个数的程序
非常实用,测试非常o.k.

yecaiping

eachy斑主:
其实我对lisp是不太懂的，我只会利用。统计文字个数对于我来说非常重要，因为我经常要统计料单，统计图块的程序我目前用的非常成熟，希望统计文字能够好像以下统计图块这样方便运用，非常感谢！

2. (defun lststr (str / pos numlst chr len wrd wrdlst)
   
3. (setq pos 1)
   
4. (setq numlst '())
   
5. (setq wrdlst '())
   
6. (setq chr (substr str pos 1))
   
7. (while (/= chr "")
   
8.     (if (= chr ",")
   
9.        (setq numlst (append numlst (list pos)))
   
10.     )
    
11.   (setq pos (1+ pos))
    
12.   (setq chr (substr str pos 1))
    
13. );while
    
14. (setq numlst (append numlst (list (1+ (strlen str)))))
    
15. (setq pos 1)
    
16. (setq len (1- (car numlst)))
    
17. (setq wrd (substr str pos len))
    
18. (while (/= wrd "")
    
19.   (setq wrdlst (append wrdlst (list wrd)))
    
20.   (setq pos (1+ (car numlst)))
    
21.   (if (> (length numlst) 1)
    
22.     (setq len (1- (- (cadr numlst) (car numlst) )) )
    
23.   )
    
24.   (setq numlst (cdr numlst))
    
25.   (setq wrd (substr str pos len))
    
26. )
    
27. wrdlst
    
28. )
    
29. 
    
30. 
    
31. (Defun addsp (strn / scount)
    
32. (setq scount (strlen strn))
    
33. (repeat (- 10 scount)
    
34.   (setq strn (strcat strn " "))
    
35. )
    
36. strn
    
37. )
    
38. 
    
39. (defun c:blcount (/ record blnme name v1  outfl blklst bllst blist)
    
40. (SETVAR "CMDECHO" 0)
    
41. (setq blist (STRCASE (getstring "\nEnter name(s) of blocks to count or RETURN for all: ")))
    
42. (if (= Blist "")
    
43.   (setq record (cdr (assoc 2 (tblnext "block" t))))
    
44.   (setq record (car (setq blist2 (lststr blist))))
    
45. )
    
46. (setq blklst '())
    
47. (princ "\nSearching for blocks... Please wait.  ")
    
48. (while record
    
49.    (setq blnme (cons 2 record))
    
50.    (setq v1 (ssget "x" (list blnme) ))
    
51.      (if v1
    
52.         (progn
    
53.         (setq bllst (strcat (addsp record) "\t" (itoa (sslength v1)) "\n"))
    
54.         (princ bllst)
    
55.         (setq blklst (append blklst (list bllst)))
    
56.         );progn
    
57.      );if
    
58.      (if (= Blist "")
    
59.         (setq record (cdr (assoc 2 (tblnext "block"))))
    
60.         (progn
    
61.           (setq blist2 (cdr blist2))
    
62.           (setq record (car blist2))
    
63.         )
    
64.      )
    
65. 
    
66. (princ "\nSearching for blocks... Please wait.  ")
    
67. );while
    
68. (princ "\n图块数量已经统计到")(princ "临时")
    
69. (setq outfl (open "d:/临时.xls" "w"))
    
70. (foreach n blklst (princ n outfl))
    
71. (close outfl)
    
72. (command "_ai_editcustfile" "d:/临时.xls")
    
73. (princ)
    
74. )

(defun lststr (str / pos numlst chr len wrd wrdlst)<br /> (setq pos 1)<br /> (setq numlst '())<br /> (setq wrdlst '())<br /> (setq chr (substr str pos 1))<br /> (while (/= chr "")<br />     (if (= chr ",")<br />        (setq numlst (append numlst (list pos)))<br />     )<br />   (setq pos (1+ pos))<br />   (setq chr (substr str pos 1))<br /> );while<br /> (setq numlst (append numlst (list (1+ (strlen str)))))<br /> (setq pos 1)<br /> (setq len (1- (car numlst)))<br /> (setq wrd (substr str pos len))<br /> (while (/= wrd "")<br />   (setq wrdlst (append wrdlst (list wrd)))<br />   (setq pos (1+ (car numlst)))<br />   (if (> (length numlst) 1)<br />     (setq len (1- (- (cadr numlst) (car numlst) )) )<br />   )<br />   (setq numlst (cdr numlst))<br />   (setq wrd (substr str pos len))<br /> )<br /> wrdlst<br /> )<br /> <br /> <br /> (Defun addsp (strn / scount)<br /> (setq scount (strlen strn))<br /> (repeat (- 10 scount)<br />   (setq strn (strcat strn " "))<br /> )<br /> strn<br /> )<br /> <br /> (defun c:blcount (/ record blnme name v1  outfl blklst bllst blist)<br /> (SETVAR "CMDECHO" 0)<br /> (setq blist (STRCASE (getstring "\nEnter name(s) of blocks to count or RETURN for all: ")))<br /> (if (= Blist "")<br />   (setq record (cdr (assoc 2 (tblnext "block" t))))<br />   (setq record (car (setq blist2 (lststr blist))))<br /> )<br /> (setq blklst '())<br /> (princ "\nSearching for blocks... Please wait.  ")<br /> (while record<br />    (setq blnme (cons 2 record))<br />    (setq v1 (ssget "x" (list blnme) ))<br />      (if v1<br />         (progn<br />         (setq bllst (strcat (addsp record) "\t" (itoa (sslength v1)) "\n"))<br />         (princ bllst)<br />         (setq blklst (append blklst (list bllst)))<br />         );progn<br />      );if<br />      (if (= Blist "")<br />         (setq record (cdr (assoc 2 (tblnext "block"))))<br />         (progn<br />           (setq blist2 (cdr blist2))<br />           (setq record (car blist2))<br />         )<br />      )<br /> <br /> (princ "\nSearching for blocks... Please wait.  ")<br /> );while<br /> (princ "\n图块数量已经统计到")(princ "临时")<br /> (setq outfl (open "d:/临时.xls" "w"))<br /> (foreach n blklst (princ n outfl))<br /> (close outfl)<br /> (command "_ai_editcustfile" "d:/临时.xls")<br /> (princ)<br /> )

mann_ygw

我都希望统计文字能够达到这个效果！呵呵！

yecaiping

这个问题很难吗？高手在哪阿？

five321

确实truetable 就不错啊

夜精灵

要是有高手按照那个图块统计的方式改下就好了

yecaiping

期待高手的出现！

dtlin

谁给我个代码，急用，谢谢好心人了

hh2776

不劳而获的人。你的要求过分了。

yecaiping

我相信很多人都很需要这样的程序！

yws138

不错