[LISP程序]：文字计数-累加

梦断江南

2. 
   
3.   [FONT=courier new]
   
4. (princ "\ntcal=====txt文字计数-累加----------- lxx.2001.6")
   
5. (defun c:tcal (/ ss i nall ent entl i nmb nall nalls k dec)
   
6.   (princ "\ntcal=====txt文字计数-累加----------- lxx.2001.6")
   
7.   (setq ss (ssget '((0 . "TEXT")))
   
8.         i 0
   
9.         nall 0)
   
10.   (repeat (sslength ss)
    
11.     (setq ent (ssname ss i)
    
12.           entl (entget ent)
    
13.           i (1+ i)
    
14.           nmb (atof (cdr(assoc 1 entl)))
    
15.           nall (+ nmb nall)
    
16.     )
    
17.   )
    
18.   (setq nalls (rtos nall 2))
    
19.   (princ "\n累加总数=")(princ nalls)
    
20.   (setq k (getstring "\n标注出总数 N/<Y>:"))
    
21.   (if (and k (/= "N" (strcase k)))
    
22.     (progn
    
23.       (if (not (setq dec (getint "\n标注精度<3>:")))
    
24.           (setq dec 3)
    
25.       )
    
26.       (setq nalls (rtos nall 2 dec))
    
27.       (princ "\n定位点:")
    
28.       (command "text" pause "300" "0" nalls ^c)       
    
29.     )
    
30.   )
    
31.   (princ)
    
32. )
    
33. ;;;;
    
34. 
    
35.   [/FONT]
    

<br />   [FONT=courier new]<br /> (princ "\ntcal=====txt文字计数-累加----------- lxx.2001.6")<br /> (defun c:tcal (/ ss i nall ent entl i nmb nall nalls k dec)<br />   (princ "\ntcal=====txt文字计数-累加----------- lxx.2001.6")<br />   (setq ss (ssget '((0 . "TEXT")))<br />         i 0<br />         nall 0)<br />   (repeat (sslength ss)<br />     (setq ent (ssname ss i)<br />           entl (entget ent)<br />           i (1+ i)<br />           nmb (atof (cdr(assoc 1 entl)))<br />           nall (+ nmb nall)<br />     )<br />   )<br />   (setq nalls (rtos nall 2))<br />   (princ "\n累加总数=")(princ nalls)<br />   (setq k (getstring "\n标注出总数 N/<Y>:"))<br />   (if (and k (/= "N" (strcase k)))<br />     (progn<br />       (if (not (setq dec (getint "\n标注精度<3>:")))<br />           (setq dec 3)<br />       )<br />       (setq nalls (rtos nall 2 dec))<br />       (princ "\n定位点:")<br />       (command "text" pause "300" "0" nalls ^c)        <br />     )<br />   )<br />   (princ)<br /> )<br /> ;;;;<br /> <br />   [/FONT]<br />