LISP 块自动编号的问题

21842359@qq.com

想实现此功能    我的编号规则是“区域 - 自动编号”；
    想实现的是先提示输入区域，再输入开始编号，再选择块，直到结束;
    比如先输入区域A，再输入开始编号1，选择了100个块，那么建立的编号是A-1到A-100;

    现在的图纸是有很多块，有的块有自定义属性NO,用于编号，有的块没有此属性;

    现在就是想点击块时，查找是否有此属性（属性名忽略大小写），有此属性就将此属性值设计为当前的编号值，如果没有此属性就添加此属性NO，再将此属性设置成当前编号值，这样的好实现吗，有没有大神能实现这个功能 ？？？

csharp

对不含属性的insert追加属性使用a/vlisp是一件麻烦事，用arx或c#就简单了

csharp

用 netload 加载这个函数 http://bbs.xdcad.net/thread-681872-1-1.html

1. (defun c:tt (/ qy num ss sl e el obj lst bp up)
   
2.   (if (and (setq qy (getstring "\n区域: "))
   
3.            (/= qy "")
   
4.            (setq num (getint "\n起始编号: "))
   
5.            (setq ss (ssget '((0 . "Insert"))))
   
6.       )
   
7.     (progn
   
8.       (setq sl (sslength ss))
   
9.       (while (setq e (ssname ss (setq sl (1- sl))))
   
10.         (setq obj (vlax-ename->vla-object e)
    
11.               el  (entget e)
    
12.         )
    
13.         (if (and (vla-get-hasattributes obj)
    
14.                  (setq lst (vl-member-if
    
15.                              '(lambda (x) (= (strcase (vla-get-tagstring x)) "NO"))
    
16.                              (vlax-invoke obj 'GetAttributes)
    
17.                            )
    
18.                  )
    
19.             )
    
20.           (vla-put-textstring (car lst) (strcat qy "-" (itoa num)))
    
21.           (progn
    
22.             (vla-getboundingbox obj 'bp 'up)
    
23.             (insert_appendattrib
    
24.               e
    
25.               (safearray-value up)
    
26.               "NO"
    
27.               (strcat qy "-" (itoa num))
    
28.             )
    
29.           )
    
30.         )
    
31.         (setq num (1+ num))
    
32.       )
    
33.     )
    
34.   )
    
35.   (princ)
    
36. )

(defun c:tt (/ qy num ss sl e el obj lst bp up)<br />   (if (and (setq qy (getstring "\n区域: "))<br />            (/= qy "")<br />            (setq num (getint "\n起始编号: "))<br />            (setq ss (ssget '((0 . "Insert"))))<br />       )<br />     (progn<br />       (setq sl (sslength ss))<br />       (while (setq e (ssname ss (setq sl (1- sl))))<br />         (setq obj (vlax-ename->vla-object e)<br />               el  (entget e)<br />         )<br />         (if (and (vla-get-hasattributes obj)<br />                  (setq lst (vl-member-if<br />                              '(lambda (x) (= (strcase (vla-get-tagstring x)) "NO"))<br />                              (vlax-invoke obj 'GetAttributes)<br />                            )<br />                  )<br />             )<br />           (vla-put-textstring (car lst) (strcat qy "-" (itoa num)))<br />           (progn<br />             (vla-getboundingbox obj 'bp 'up)<br />             (insert_appendattrib<br />               e<br />               (safearray-value up)<br />               "NO"<br />               (strcat qy "-" (itoa num))<br />             )<br />           )<br />         )<br />         (setq num (1+ num))<br />       )<br />     )<br />   )<br />   (princ)<br /> )