已解决：查找文字后，定位并统计数量
本帖最后由 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等
谢谢
429014673 发表于 2012-5-14 19:54 static/image/common/back.gif
严哥,这个很厉害,可以帮忙搞一个可以亮显的,没有画圆的吗?...我想找出相同的编号进行下一步操作....例如改 ...
;;;简易查找文本并亮显 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)
)
可以的，请使用下面的代码即可。
;选中文字做圆圈标记并显示数量 明经 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-28 22:35 编辑
;选中文字做圆圈标记并显示数量 明经 ZZXXQQ 2011.1.27
(defun c:tt ()
(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)))))
)
(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 50)
(setq i (1+ i))
)
(princ "\n")
(princ (sslength ss))
))
(setvar "CMDECHO" 1)
(princ)
)
非常感谢，我的是2002版本，暂时没有提示成功
TT命令改为TTA了
是否漏了这个
(vl-load-com) Andyhon 发表于 2011-1-28 09:01 static/image/common/back.gif
是否漏了这个
(vl-load-com)
经过试验，不是这个原因 建议您上传调试用的文件(*.Dwg) Andyhon 发表于 2011-1-28 11:14 static/image/common/back.gif
建议您上传调试用的文件(*.Dwg)
例如查找AA50，自动找到AA50.AA50-AA40.AA50,15M等，并在每个文字上画个圆圈或其他醒目的标记，方便命令执行后，在图形上直接看到查找到的文字
(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:15 编辑
谢谢。这个思路很好，加上版主和大侠帮忙,终于做成了 不错。这很实用，弥补了CAD菜单里的查找功能不足的地方。版主很给力呀！