【FB】找到属性文字标记含"灯"的块并计数

kucha007

求助出处：http://bbs.mjtd.com/forum.php?mo ... 762&fromuid=7329538

1. ;找到属性文字标记含"灯"的块并计数
   
2. (defun C:FB (/ SS i obj AttLst Flag Count STR p1 p2)
   
3.   (if (setq SS (ssget '((0 . "INSERT")(66 . 1)))) ;只选属性块
   
4.     (progn
   
5.       (setq Count 0) ;计数归零
   
6.       (repeat (setq i (sslength SS))
   
7.         (setq obj (vlax-ename->vla-object (ssname SS (setq i (1- i)))))
   
8.         (setq AttLst (vlax-safearray->list
   
9.                        (vlax-variant-value (vla-GetAttributes Obj))
   
10.                      )
    
11.         ) ;收集块内属性成表
    
12.         (setq Flag T)
    
13.         (while (and Flag AttLst)
    
14.           (if (wcmatch (vla-get-TextString (car AttLst)) "*灯*")  ;判断标记是否有"灯"
    
15.             (progn
    
16.               (setq Count (1+ Count))
    
17.               (setq Flag nil) ;找到一次就停止循环
    
18.             )
    
19.             (setq AttLst (cdr AttLst))
    
20.           )
    
21.         )
    
22.       )
    
23.       (if (eq Count 0)
    
24.         (princ "\n——★★★ 未找到符合条件的属性块 ★★★——")
    
25.         (if
    
26.           (and
    
27.             (setq STR (strcat "共选择了" (rtos Count 2 0) "个符合条件的属性块"))
    
28.             (setq p1 (getpoint "\n→请指定文字插入点："))
    
29.             (setq p2 (getpoint p1 "\n→请指定第二点确定文字高度："))
    
30.           )
    
31.           (entmake
    
32.             (list
    
33.               '(0 . "TEXT")
    
34.               (cons 1 STR) ;文字内容
    
35.               (cons 8 (getvar "Clayer")) ;图层名称
    
36.               (cons 10 p1) ;插入点
    
37.               (cons 40 (distance p1 p2)) ;文字高度
    
38.             )
    
39.           )
    
40.         )
    
41.         
    
42.       )
    
43.       (command "redraw")
    
44.       (princ)
    
45.     )
    
46.   )
    
47. )
    
48. 
    

;找到属性文字标记含"灯"的块并计数<br /> (defun C:FB (/ SS i obj AttLst Flag Count STR p1 p2) <br />   (if (setq SS (ssget '((0 . "INSERT")(66 . 1)))) ;只选属性块<br />     (progn <br />       (setq Count 0) ;计数归零<br />       (repeat (setq i (sslength SS)) <br />         (setq obj (vlax-ename->vla-object (ssname SS (setq i (1- i)))))<br />         (setq AttLst (vlax-safearray->list <br />                        (vlax-variant-value (vla-GetAttributes Obj))<br />                      )<br />         ) ;收集块内属性成表<br />         (setq Flag T)<br />         (while (and Flag AttLst) <br />           (if (wcmatch (vla-get-TextString (car AttLst)) "*灯*")  ;判断标记是否有"灯"<br />             (progn <br />               (setq Count (1+ Count))<br />               (setq Flag nil) ;找到一次就停止循环<br />             )<br />             (setq AttLst (cdr AttLst))<br />           )<br />         )<br />       )<br />       (if (eq Count 0) <br />         (princ "\n——★★★ 未找到符合条件的属性块 ★★★——")<br />         (if<br />           (and<br />             (setq STR (strcat "共选择了" (rtos Count 2 0) "个符合条件的属性块"))<br />             (setq p1 (getpoint "\n→请指定文字插入点："))<br />             (setq p2 (getpoint p1 "\n→请指定第二点确定文字高度："))<br />           )<br />           (entmake <br />             (list <br />               '(0 . "TEXT")<br />               (cons 1 STR) ;文字内容<br />               (cons 8 (getvar "Clayer")) ;图层名称<br />               (cons 10 p1) ;插入点<br />               (cons 40 (distance p1 p2)) ;文字高度<br />             )<br />           )<br />         )<br />         <br />       )<br />       (command "redraw")<br />       (princ)<br />     )<br />   )<br /> )<br /> <br />

crtrccrt

注意筛选时注意66组码

Noangler

支持点赞！

lxl217114

点赞，谢谢分享

664571221

谢谢大神，功能很不错了，要是能统计多个就好了，比如灯  开关，两断文字列出有几个灯几个开关或则还有其他的

kucha007

664571221 发表于 2023-5-9 16:23
谢谢大神，功能很不错了，要是能统计多个就好了，比如灯  开关，两断文字列出有几个灯几个开关或则还有其他 ...

你要的太复杂了，花点钱让别人给你写吧。

664571221

能不能后面不要有小数，因为个数都是整数

kucha007

664571221 发表于 2023-5-9 17:17
能不能后面不要有小数，因为个数都是整数

这个：(rtos Count)
改成：(rtos Count 2 0)

菜鸟初来乍到

点赞，支持一下

nsh935

谢谢分享！