统计长度和块数量的小工具。练习之作，功能简单，有待完善

mituzhe

刚好学习到eval这个函数，练习用了一下。写了一个统计长度和块数量的小工具。很初级的东西。大佬们不要见笑。

2. ;-------------------------------------------------------------------------------------------------
   
3. ;长度统计，块数量统计
   
4. (defun c:tjcd (/ e filter i s ss totallength)
   
5.   (while (not (setq e (car (entsel)))))
   
6.   (setq filter (mapcar '(lambda (x) (list 'assoc x '(entget e))) (list 0 2 8))
   
7.         filter (mapcar 'eval filter)
   
8.         filter (vl-remove-if 'not filter)
   
9.   )
   
10.   (setq ss          (ssget "X" filter)
    
11.         i           -1
    
12.         totalLength 0
    
13.   )
    
14.   (sssetfirst nil ss)
    
15.   (cond
    
16.     ((wcmatch (cdr (assoc 0 filter)) "*LINE")
    
17.      (while (and (< (setq i (1+ i)) (sslength ss)) (setq s (ssname ss i)))
    
18.        (setq totalLength (+ (vla-get-Length (vlax-ename->vla-object s)) totalLength))
    
19.      )
    
20.      (princ (strcat "总长度为：" (rtos (/ totalLength 1000.) 2 2) "米"))
    
21.      (princ)
    
22.     )
    
23.     ((wcmatch (cdr (assoc 0 filter)) "INSERT")
    
24.      (princ (strcat "找到：" (rtos (sslength ss) 2 0) "个"))
    
25.      (princ)
    
26.     )
    
27.   )
    
28. )

;-------------------------------------------------------------------------------------------------<br /> ;长度统计，块数量统计<br /> (defun c:tjcd (/ e filter i s ss totallength) <br />   (while (not (setq e (car (entsel)))))<br />   (setq filter (mapcar '(lambda (x) (list 'assoc x '(entget e))) (list 0 2 8))<br />         filter (mapcar 'eval filter)<br />         filter (vl-remove-if 'not filter)<br />   )<br />   (setq ss          (ssget "X" filter)<br />         i           -1<br />         totalLength 0<br />   )<br />   (sssetfirst nil ss)<br />   (cond <br />     ((wcmatch (cdr (assoc 0 filter)) "*LINE")<br />      (while (and (< (setq i (1+ i)) (sslength ss)) (setq s (ssname ss i))) <br />        (setq totalLength (+ (vla-get-Length (vlax-ename->vla-object s)) totalLength))<br />      )<br />      (princ (strcat "总长度为：" (rtos (/ totalLength 1000.) 2 2) "米"))<br />      (princ)<br />     )<br />     ((wcmatch (cdr (assoc 0 filter)) "INSERT")<br />      (princ (strcat "找到：" (rtos (sslength ss) 2 0) "个"))<br />      (princ)<br />     )<br />   )<br /> )

magicheno

感谢分享源码~