[讨论]：返回选择集内各类型图元名称及数量－函数优化

netbee

返回选择集内各类型图元名称及数量　
;;当参数为nil时为全图，为T时为当前选择。

2. 
   
3. (defun NBTF_GetObjTypenum (ss / i j ee objslst ObjName objlst)
   
4. ;;  (VL-LOAD-COM)
   
5.   ;;若不为选择集且不为nil
   
6.   (if (and (/= (type ss) 'PICKSET)
   
7.            ss
   
8.       ) ;_ 结束and
   
9.     (setq ss (ssget "_i"))
   
10.   ) ;_ 结束if
    
11.   ;;若选择集仍为空
    
12.   (if(null ss)(setq ss (ssget "_X")))
    
13.   ;;若选择集存在
    
14.   (if ss
    
15.     (progn
    
16.       ;;初始化计数器及总数
    
17.       (setq i -1
    
18.             j (1-(sslength ss))
    
19.       ) ;_ 结束setq
    
20.       (while (< i j)
    
21.         (setq ee      (ssname ss (setq i(1+ i)));_读图元
    
22.               objname (vla-get-ObjectName  (vlax-ename->vla-object ee))
    
23.         ) ;_ 结束setq
    
24.         ;;写计数表
    
25.         (if (setq objlst (assoc objname objSlst))
    
26.           (setq        objslst
    
27.                  (subst (cons objname (1+ (cdr objlst))) objlst objslst)
    
28.           ) ;_ 结束setq
    
29.           (setq objslst (append (LIST (cons objname 1)) objslst))
    
30.         ) ;_ 结束if
    
31.       ) ;_ 结束while
    
32.     ) ;_ 结束progn
    
33.   ) ;_ 结束if
    
34.   objslst
    
35. ) ;_ 结束defun
    

<br /> (defun NBTF_GetObjTypenum (ss / i j ee objslst ObjName objlst)<br /> ;;  (VL-LOAD-COM)<br />   ;;若不为选择集且不为nil<br />   (if (and (/= (type ss) 'PICKSET)<br />            ss<br />       ) ;_ 结束and<br />     (setq ss (ssget "_i"))<br />   ) ;_ 结束if<br />   ;;若选择集仍为空<br />   (if(null ss)(setq ss (ssget "_X")))<br />   ;;若选择集存在<br />   (if ss<br />     (progn<br />       ;;初始化计数器及总数<br />       (setq i -1<br />             j (1-(sslength ss))<br />       ) ;_ 结束setq<br />       (while (< i j)<br />         (setq ee      (ssname ss (setq i(1+ i)));_读图元<br />               objname (vla-get-ObjectName  (vlax-ename->vla-object ee))<br />         ) ;_ 结束setq<br />         ;;写计数表<br />         (if (setq objlst (assoc objname objSlst))<br />           (setq        objslst<br />                  (subst (cons objname (1+ (cdr objlst))) objlst objslst)<br />           ) ;_ 结束setq<br />           (setq objslst (append (LIST (cons objname 1)) objslst))<br />         ) ;_ 结束if<br />       ) ;_ 结束while<br />     ) ;_ 结束progn<br />   ) ;_ 结束if<br />   objslst<br /> ) ;_ 结束defun<br />

在图元数目过多时，用while遍历很慢，不知能不能优化呢？
能用Active方法来搞就好了。
关键是参数只能是LISP的选择集变量。

eachy

2. 
   
3. (defun ss_typeandNum (ss / )
   
4.   (if (and (/= (type ss) 'PICKSET)
   
5.            ss
   
6.       ) ;_ 结束and
   
7.     (setq ss (ssget "_i"))
   
8.   ) ;_ 结束if
   
9.   ;;若选择集仍为空
   
10.   (if (null ss)
    
11.     (setq ss (ssget "_X"))
    
12.   )
    
13.   (if ss
    
14.     (progn
    
15.       (vla-delete);_清除一个Bug
    
16.       (command ".select" ss "")
    
17.       (vlax-for        obj (vla-get-activeselectionset
    
18.                       (vla-get-activedocument (vlax-get-acad-object))
    
19.                     )
    
20.         .
    
21.         .
    
22.         .
    
23.       )
    
24.     )
    
25.   )
    
26. )

<br /> (defun ss_typeandNum (ss / )<br />   (if (and (/= (type ss) 'PICKSET)<br />            ss<br />       ) ;_ 结束and<br />     (setq ss (ssget "_i"))<br />   ) ;_ 结束if<br />   ;;若选择集仍为空<br />   (if (null ss)<br />     (setq ss (ssget "_X"))<br />   )<br />   (if ss<br />     (progn<br />       (vla-delete);_清除一个Bug<br />       (command ".select" ss "")<br />       (vlax-for        obj (vla-get-activeselectionset<br />                       (vla-get-activedocument (vlax-get-acad-object))<br />                     )<br />         .<br />         .<br />         .<br />       )<br />     )<br />   )<br /> )

fools

慢的原因不是while,而是你用assoc扫描一个无序表
应该先排序再统计
方法1:
[php]
(DEFUN test1 (ss / tmplst i item)
  ;;选择集->表(也可直接用ssname添加)
  (SETQ ss (VL-REMOVE-IF 'LISTP (MAPCAR 'CADR (SSNAMEX ss))))
  ;;获取图元类型(DXF0)
  (SETQ        ss (MAPCAR (FUNCTION (LAMBDA (x) (CDR (ASSOC 0 (ENTGET x)))))
                   ss
           )
  )
  ;;排序
  (SETQ ss (VL-SORT ss '<))
  ;;统计(也可用vl-remove-if方法)
  (SETQ tmplst nil)
  (SETQ i 1)
  (WHILE ss
    (SETQ item (CAR ss)
          ss  (CDR ss)
    )
    (IF        (= item (CAR ss))
      (SETQ i (1+ i))
      (SETQ tmplst (CONS (LIST item i) tmplst)
            i           1
      )
    )
  )
  tmplst
)
[/php]

不排序的方法
方法2:
[php]
(DEFUN test2 (ss / A LEN LST N RETURN)
  (SETQ lst nil)
  (REPEAT (SETQ n (SSLENGTH ss))
    (SETQ lst (CONS (CDR (ASSOC 0 (ENTGET (SSNAME ss (SETQ n (1- n))))))
                    lst
              )
    )
  )
  (SETQ len (LENGTH lst))
  (WHILE lst
    (SETQ a (CAR lst))
    (SETQ lst (VL-REMOVE-IF (FUNCTION (LAMBDA (x) (= a x))) lst))
    (SETQ return (CONS (LIST a (- len (SETQ len (LENGTH lst)))) return))
  )
  return
)
[/php]

这两种方法在我机器上测试速度差不多

雨箭风刀

我觉得用了 append 是主要的原因之一


试试我的
10万个实体统计用5秒; 5万个实体2.4秒,  平均每秒统计2万个实体

1. 
   
2. 命令: CNTSS
   
3. 回车全选!
   
4. 选择对象:
   
5. 共选中100672个实体
   
6. 用时
   
7. 00时00分04.97秒
   
8. ((SOLID . 45) (HATCH . 2149) (INSERT . 4759) (DIMENSION . 234) (TEXT . 4715)
   
9. (LWPOLYLINE . 10338) (LINE . 78432))
   
10. 
    

复制代码

fools

好象不是assoc的问题,
刚才把楼主的(vla-get-ObjectName  (vlax-ename->vla-object ...
改成(cdr (assoc 0 (entget ...
速度提高了6倍,呵呵

所以如果不需要得到"AcDb...",那就直接用DXF0
如果需要得到"AcDb...",那还是可以用dxf0,然后设一个一一对应的表,将dxf0 转换为AcDb...
或者使用dxf100获取"AcDb..."

netbee

测试了一下，我的图形文件有对象29907个，

采用

2. 
   
3. (vlax-for obj (vla-get-activeselectionset
   
4.                      (vla-get-activedocument (vlax-get-acad-object))
   
5.                    ) ;_ 结束vla-get-activeselectionset
   
6.        (setq
   
7.          objname (vla-get-ObjectName obj)
   
8.        ) ;_ 结束setq
   
9.        ;;写计数表
   
10.        (setq objlst (cons objname objlst))
    
11.      ) ;_ 结束vlax-for
    

<br /> (vlax-for obj (vla-get-activeselectionset<br />                      (vla-get-activedocument (vlax-get-acad-object))<br />                    ) ;_ 结束vla-get-activeselectionset<br />        (setq<br />          objname (vla-get-ObjectName obj)<br />        ) ;_ 结束setq<br />        ;;写计数表<br />        (setq objlst (cons objname objlst))<br />      ) ;_ 结束vlax-for<br />

读对象名称列表就需要7秒多。

而采用

1. 
   
2. (SETQ lst nil)
   
3.   (REPEAT (SETQ n (SSLENGTH ss))
   
4.     (SETQ lst (CONS (CDR (ASSOC 100 (reverse(ENTGET (SSNAME ss (SETQ n (1- n)))))))
   
5.             lst
   
6.           )
   
7.     )
   
8.   )
   

复制代码

只需要2秒多

看来纯LISP语言速度比ActiveX快多了。