【求助】改为框选

429014673

;;统计图形中的文本个数
(defun C:TT (/ SS LST I STR TMP)
    (if    (setq SS (ssget "X" '((0 . "*TEXT"))))
    (progn
        ;;统计数量
        (setq LST '()
          I   0
        )
        (repeat (sslength SS)
        (setq STR (cdr (assoc 1 (entget (ssname SS I)))))
        (if (setq TMP (assoc STR LST))
            (setq LST (subst (list STR (1+ (cadr TMP)))
                     TMP
                     LST
                  )
            )
            (setq LST (cons (list STR 1) LST))
        )
        (setq I (1+ I))
        )
        ;;输出结果
        (foreach TMP LST
;;;        (if (= (cadr TMP) 1)
;;;            ()
        (princ
            (strcat "\n内容: "
                (car TMP)
                " 个数为: "
                (itoa (cadr TMP))
            )
        )
;;;        )
        )
    ) ;_结束progn
    (princ "\n图形中不存在文本对象。")
    ) ;_结束if
    (princ)
) ;_结束defun

程序出自http://bbs.mjtd.com/forum.php?mod=viewthread&tid=62886


如上图，希望可以改为框选，希望结果可以写在模型空间上（如上图右边）（原显示在命令行中，查看不方便）谢谢。。。

jake2017

谢谢大神分享！

yjr111

字符串处理稍微熟悉一点，自己写了一个，看看能不能满足你的要求。。。

2. (defun c:tjwb(/ LST1 N E S WB SS lst2 lst_new shuz lst lst11 lst12 height p1 WBJULI)
   
3.   (setq ss(ssget '((0 . "TEXT")))N 0)
   
4.   (REPEAT (SSLENGTH SS)
   
5.     (SETQ E(SSNAME SS N)
   
6.     S(ENTGET E)
   
7.     WB(CDR(ASSOC 1 S))
   
8.     height (CDR(ASSOC 40 s))
   
9.           LST1 (CONS WB LST1)
   
10.     )
    
11.        (SETQ  N (1+ N))
    
12.     )
    
13.    (while (>(LENGTH LST1)0)
    
14.    (IF (NOT(MEMBER (NTH 0 LST1)LST2))
    
15.      (progn
    
16.      (SETQ LST2 (append LST2 (list(strcat(NTH 0 LST1) "=")))
    
17.            lst_new(vl-remove (NTH 0 LST1) LST1)
    
18.            shuz (itoa(-(LENGTH LST1)(length lst_new)))
    
19.            lst2 (append lst2 (list shuz))
    
20.            lst1 lst_new)
    
21.      )
    
22.      )
    
23.      (setq lst (cons lst2 lst)lst2 nil)
    
24.      )
    
25.   (mapcar '(lambda(x) (setq lst11(cons(strcat (car x)(cadr x))lst11))) lst)
    
26.   (setq lst11(acad_strlsort lst11))
    
27.   (setq WBJULI (* height 1.4))
    
28.   (setq p1 (getpoint "\n请指定插入点："))
    
29.   (setq n 0)
    
30.   (foreach x lst11
    
31.      (command "text" p1 height "" x)
    
32.      (command )
    
33.     (setq p1 (list (car p1)(- (cadr p1) WBJULI) (caddr p1)))
    
34.     (setq n(1+ n))
    
35.    )
    
36.    (princ)
    
37.   )
    
38.   
    
39.    
    
40.   

(defun c:tjwb(/ LST1 N E S WB SS lst2 lst_new shuz lst lst11 lst12 height p1 WBJULI)<br />   (setq ss(ssget '((0 . "TEXT")))N 0)<br />   (REPEAT (SSLENGTH SS)<br />     (SETQ E(SSNAME SS N)<br />     S(ENTGET E)<br />     WB(CDR(ASSOC 1 S))<br />     height (CDR(ASSOC 40 s))<br />           LST1 (CONS WB LST1)<br />     )<br />        (SETQ  N (1+ N))<br />     )<br />    (while (>(LENGTH LST1)0)<br />    (IF (NOT(MEMBER (NTH 0 LST1)LST2))<br />      (progn<br />      (SETQ LST2 (append LST2 (list(strcat(NTH 0 LST1) "=")))<br />            lst_new(vl-remove (NTH 0 LST1) LST1)<br />            shuz (itoa(-(LENGTH LST1)(length lst_new)))<br />            lst2 (append lst2 (list shuz))<br />            lst1 lst_new)<br />      )<br />      )<br />      (setq lst (cons lst2 lst)lst2 nil)<br />      )<br />   (mapcar '(lambda(x) (setq lst11(cons(strcat (car x)(cadr x))lst11))) lst)<br />   (setq lst11(acad_strlsort lst11))<br />   (setq WBJULI (* height 1.4))<br />   (setq p1 (getpoint "\n请指定插入点："))<br />   (setq n 0)<br />   (foreach x lst11<br />      (command "text" p1 height "" x)<br />      (command )<br />     (setq p1 (list (car p1)(- (cadr p1) WBJULI) (caddr p1)))<br />     (setq n(1+ n))<br />    )<br />    (princ)<br />   )<br />   <br />     <br />   

yjr111

yjr111 发表于 2011-11-25 20:29
字符串处理稍微熟悉一点，自己写了一个，看看能不能满足你的要求。。。

开头加一句(setvar "osmode" 0)即可

669423907

yjr111 发表于 2011-11-25 20:29
字符串处理稍微熟悉一点，自己写了一个，看看能不能满足你的要求。。。

这个很适合我！谢谢！

hnfsf

挺不错的，方便使用，谢谢共享

注册

这个对我编门窗表有好处，谢谢

★飞飛★

挺不错的，对统计材料编号数量很方便，谢谢共享

lpl

非常不错的代码

阿夏哥

正是我想要的

海盗曹

来学习一下好代码~