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

yjr111 · 发表于 2011-7-30 08:38:08

感谢ZZXXQQ的源程序，学习并试着修改了一下。。。。
;选中文字做圆圈标记并显示数量明经 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)))))
)

(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)))
(setq ybl (getreal"\n 请输入圆的大小：<右键默认1000>"))
(if (not ybl )(setq ybl 1000))
(command "layer" "make" "circle" "c" 1 "circle" "")
(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 "")
)
(command "")
)
  (setvar "CMDECHO" 1)
(princ)
)

cxs259 · 发表于 2011-7-30 12:17:10

不错，能否一次性可以选择上并知道“总共找到”的数量？

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)
)

lgttblue · 发表于 2011-7-30 13:45:34

赞一个

manes2011 · 发表于 2011-10-14 09:52:34

发帖回复，呵呵！

湜１只鱼 · 发表于 2011-10-28 18:47:55

很好的功能。谢谢。

siagui · 发表于 2011-11-25 15:33:10

太好了，谢谢楼主

siagui · 发表于 2011-11-25 15:33:42

真的吗，实在是厉害

siagui · 发表于 2011-11-25 15:35:23

牛人啊，不看看不行，哈哈哈哈哈哈

siagui · 发表于 2011-11-25 15:36:14

有插件直接下吗，哈哈哈

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

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

点评

评分