nishuihanjian 发表于 2017-8-7 12:06:52

快速找出所含文字并用圆形云线框出来

求大神写个程序：快速找出所含的指定文字，有几处找出几处并在所有含有此文字的地方用云线框出来，云线颜色为紫色，云线自动按全局比例调整，云线范围根据字的大小的5倍确定。

springwillow 发表于 2017-8-8 15:17:57

收集的功能，跟楼主要求类似，不过不是画云线，是画圆。很久不玩lisp了
(defun c:czwz ()
(setvar "cmdecho" 0)
(command "undo" "be")
(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)))
   (entmake (list '(0 . "CIRCLE") (cons 8 "FindText")(cons 62 6)(cons 10 pt) (cons 40 (/ (distance minp maxp) 2))))
   (setq i (1+ i))
)
(princ)
))
(command "undo" "end")
(setvar "CMDECHO" 1)
(princ)
)

永不言弃 发表于 2017-8-8 09:38:37

我有一个这样的

jun353835273 发表于 2017-8-9 17:21:07

(defun c:czwz1 ( / EN ENT GETPT I MAXP MINP PT S1 SS STXT)
(setvar "cmdecho" 0)
(command "undo" "be")
(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 (and(setq ss (ssget (list '(0 . "TEXT") (cons 1 (strcat "*" stxt "*")))))
          (setq getpt(getpoint "\n指定线的起点："))          
       )
(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)))
   (entmake (list '(0 . "LINE") (cons 8 "FindText")(cons 10 getpt) (cons 11 pt)(cons 62 6) ))
   (setq i (1+ i))
)
(princ)
))
(command "undo" "end")
(setvar "CMDECHO" 1)
(princ)
)

bai2000 发表于 2017-8-7 20:36:57

同求

yaoguen 发表于 2017-8-9 13:04:43

永不言弃 发表于 2017-8-8 09:38
我有一个这样的

需要这样的插件，大牛能分享一下吗？我的QQ：80872969，谢谢！

jun353835273 发表于 2017-8-9 17:19:33

(defun c:czwz1 ( / EN ENT GETPT I MAXP MINP PT S1 SS STXT)
(setvar "cmdecho" 0)
(command "undo" "be")
(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 (and(setq ss (ssget (list '(0 . "TEXT") (cons 1 (strcat "*" stxt "*")))))
          (setq getpt(getpoint "\n指定线的起点："))

nishuihanjian 发表于 2017-9-6 10:02:51

jun353835273 发表于 2017-8-9 17:21
(defun c:czwz1 ( / EN ENT GETPT I MAXP MINP PT S1 SS STXT)
(setvar "cmdecho" 0)
(command "undo" "b ...

表示CAD2010不能用，不能画线

669423907 发表于 2017-9-14 11:43:47

jun353835273 发表于 2017-8-9 17:21
(defun c:czwz1 ( / EN ENT GETPT I MAXP MINP PT S1 SS STXT)
(setvar "cmdecho" 0)
(command "undo" "b ...

程序很好用，请问如果要改为默认全选，要怎么改吖

alexmai 发表于 2017-9-15 09:14:12

程序不能读属性块的文字，如何解决？
页: [1] 2
查看完整版本: 快速找出所含文字并用圆形云线框出来