已解决：查找文字后，定位并统计数量

xd-xdcad · 发表于 2011-1-27 13:09:55

本帖最后由 xd-xdcad 于 2011-1-29 22:26 编辑

图形中有许多单行文本，具体内容类似：AA1-11m、AA2-34m、AA34-6m、AA3、AA55等等，要求查找某一文字，并用圆圈将选择的文字圈住，同时统计出文字数量，例如以查找AA34为例，执行命令后，效果如下
1、在命令行内输入或鼠标选择已有的AA34，
2、将选中的AA34画圈做个标记（方便醒目地直观看到）
3、同时得到结果，例如命令行内显示：找到AA34，共**个
4、查找的结果包括单纯的AA34，或者文字中含有AA34的其他内容，如AA34-3，准AA34-6m等
谢谢

yjr111 · 发表于 2012-5-14 21:29:34

429014673 发表于 2012-5-14 19:54
严哥,这个很厉害,可以帮忙搞一个可以亮显的,没有画圆的吗?...我想找出相同的编号进行下一步操作....例如改 ...

;;;简易查找文本并亮显 by yjr111 2012-5-14
(defun c:ttz (/ stxt s1 ent ss )
(setq stxt (getstring "\n输入要查找的文本<右键选取>或设置(S):"))
(cond ((or(= stxt "S")(= stxt "s"))
(initget"All Same")
(setq key (getkword "\n相似全选(All)或完全匹配(Same)"))
(if (not key)
(setq key "Same")
)
(setq stxt (getstring "\n输入要查找的文本<右键选取>或设置(S):"))
)
)
(cond((and (= stxt "")
(setq s1 (entsel "\n选择标记 :"))
(setq ent (entget (car s1)))
(= (cdr (assoc 0 ent)) "TEXT")
)
(redraw (car s1) 3)
(setq stxt (cdr (assoc 1 (entget (car s1)))))
)
)
(princ"\n选择文本的查找范围")
(if (= key "Same")
(setq ss (ssget (list '(0 . "TEXT") (cons 1 (strcat stxt)))))
(setq ss (ssget (list '(0 . "TEXT") (cons 1 (strcat "*" stxt "*")))))
)
(if (and ss (> (sslength ss) 0))
(progn (princ (list "\n总共找到" (sslength ss) "处"))
(sssetfirst ss ss)
)
)
(princ)
)

;;;简易查找文本并亮显 by yjr111 2012-5-14 
(defun c:ttz (/ stxt s1 ent ss ) 
 (setq stxt (getstring "\n输入要查找的文本<右键选取>或设置(S):")) 
 (cond ((or(= stxt "S")(= stxt "s")) 
        (initget"All Same") 
        (setq key (getkword "\n相似全选(All)或完全匹配(Same)")) 
        (if (not key) 
         (setq key "Same") 
        ) 
        (setq stxt (getstring "\n输入要查找的文本<右键选取>或设置(S):")) 
       ) 
  ) 
  (cond((and (= stxt "") 
             (setq s1 (entsel "\n选择标记 :")) 
             (setq ent (entget (car s1))) 
             (= (cdr (assoc 0 ent)) "TEXT") 
        ) 
        (redraw (car s1) 3) 
        (setq stxt (cdr (assoc 1 (entget (car s1))))) 
       ) 
 ) 
 (princ"\n选择文本的查找范围") 
 (if (= key "Same") 
  (setq ss (ssget (list '(0 . "TEXT") (cons 1 (strcat stxt))))) 
  (setq ss (ssget (list '(0 . "TEXT") (cons 1 (strcat "*" stxt "*"))))) 
 ) 
 (if (and ss (> (sslength ss) 0)) 
  (progn (princ (list "\n总共找到" (sslength ss) "处")) 
         (sssetfirst ss ss) 
  ) 
 ) 
 (princ) 
)

yjr111 · 发表于 2011-7-30 13:29:01

可以的，请使用下面的代码即可。
;选中文字做圆圈标记并显示数量明经 ZZXXQQ 2011.1.27
;yjr学习并修改 2011.7.29
(DEFUN *ERROR* (msg)
 (COMMAND) (COMMAND)
 (PRINC (STRCAT "\n 警告! " "程序已经退出!"))
 (PRINC)
)
(defun c:ttz ()
(setvar "cmdecho" 0)
(setq stxt (getstring "\n输入标记<屏选> :"))
(if (and (= stxt "")
 (setq s1 (entsel "\n选择标记 :"))
 (setq ent (entget(car s1)))
 (= (cdr(assoc 0 ent)) "TEXT"))
 (setq stxt (cdr(assoc 1 (entget(car s1)))))
)

 (setq ybl (getreal"\n 请输入圆的大小：<右键默认1000>"))
(if (not ybl )(setq ybl 1000))
(command "layer" "make" "circle" "c" 1 "circle" "")

(if (setq ss (ssget (list '(0 . "TEXT") (cons 1 (strcat "*" stxt "*"))))) (progn

 (setq i 0)
 (repeat (sslength ss)
(setq en (ssname ss i))
(vla-getboundingbox(vlax-ename->vla-object en) 'minp 'maxp)
(setq minp (vlax-safearray->list minp)
 maxp (vlax-safearray->list maxp))
(setq pt (polar minp (angle minp maxp) (/ (distance minp maxp) 2)))

(command ".CIRCLE" pt ybl)
(setq i(1+ i))
)
(princ "\n")
 (princ (list "总共找到" (sslength ss)"处"))
))
 (princ "\n")
(initget 1 " Yes NO")
(setq yorn(getkword "要删除圆吗？<Yes or No>:"))
 (if (= yorn "Yes")
(progn
(setq sss (ssget "x" '((0 . "circle")(8 . "circle"))))
(command "erase" sss "")
)
(if (= yorn "No")(command ""))
)
 (setvar "CMDECHO" 1)
(princ)
)

ZZXXQQ · 发表于 2011-1-27 22:39:05

本帖最后由 ZZXXQQ 于 2011-1-28 22:35 编辑

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

xd-xdcad · 发表于 2011-1-28 08:36:24

非常感谢，我的是2002版本，暂时没有提示成功
TT命令改为TTA了

Andyhon · 发表于 2011-1-28 09:01:51

是否漏了这个
(vl-load-com)

xd-xdcad · 发表于 2011-1-28 11:11:03

Andyhon 发表于 2011-1-28 09:01
是否漏了这个
(vl-load-com)

经过试验，不是这个原因

Andyhon · 发表于 2011-1-28 11:14:48

建议您上传调试用的文件(*.Dwg)

xd-xdcad · 发表于 2011-1-28 13:49:53

Andyhon 发表于 2011-1-28 11:14
建议您上传调试用的文件(*.Dwg)

例如查找AA50，自动找到AA50.AA50-AA40.AA50,15M等，并在每个文字上画个圆圈或其他醒目的标记，方便命令执行后，在图形上直接看到查找到的文字

Andyhon · 发表于 2011-1-28 14:44:29

(setq pt (polar minp (angle minp maxp) (/ (length minp maxp) 2)))
(command ".CIRCLE" pt 50)
Try ==>
(setq pt (polar minp (angle minp maxp) (/ (Distance minp maxp) 2)))
(command ".CIRCLE" pt 10)

crazylsp · 发表于 2011-1-28 17:14:38

本帖最后由 crazylsp 于 2011-1-28 17:15 编辑

谢谢。这个思路很好，加上版主和大侠帮忙, 终于做成了

soonsos · 发表于 2011-2-4 21:11:16

不错。这很实用，弥补了CAD菜单里的查找功能不足的地方。版主很给力呀！

账号		自动登录	找回密码
密码			注册

[源码] 已解决：查找文字后，定位并统计数量

点评

评分

点评

评分

本帖子中包含更多资源

本帖子中包含更多资源

评分