Question

求CAD LISP查找文字后，定位并统计数量

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

Answer 1

不是我小气，就你这点分，有谁会花那么多时间给你去写这么繁复的lisp？现在的社会，时间就是金钱的啊！

Answer 2

;;; ____________________________________
;;; 功能：相同文字连线 不能画圈，可以连线，可以做到第3条和第4条，我也是借鉴大神的
;;; 命令：rtt
;;; ____________________________________
(setq *ent2obj* vlax-Ename->Vla-Object)
(defun c:rtt()
(SETVAR "CMDECHO" 0)
(if (setq ss (ssget ":e:s" '((0 . "TCH_TEXT,TEXT"))))
(progn
(setq ttent (ssname ss 0))
(command "layer" "m" "电气辅助线" "c" "9" "" "l" "DASH" "" "p" "n" """") ;;; 新建图层
(setq str (cdr (assoc 1 (entget ttent)))) ;;; 读取选择的文字的文字内容 ，移除第一个元素
(setq str1 (strcat "*" str "*")) ;;;功能一： strcat将多个字符串连接，将文字前后增加*，选择含有文字的所有其他文字，这个功能瞎猫碰死耗子蒙对了，这个语言还是需要系统的学习才能会用，不研究了
(setq po (getmidpo (entbox ttent)))
(setq ss (ssget "x" (list '(0 . "TCH_TEXT,TEXT") (cons 1 str1)))) ;;; 选择集所有文字且文字相关
(setq ss1 (ssget "x" (list '(0 . "TCH_TEXT,TEXT")(cons 1 str)))) ;;; 选择集所有文字且文字相同
(princ (strcat"\n共有" (itoa (sslength ss1)) "个相同文字")) ;;;功能二： 输出有几个相同的文字，为了这个功能干了有三个晚上，再也不研究这个玩意了
(princ (strcat"\n共有"(itoa (- (sslength ss) (sslength ss1))) "个相关文字"))
(if (< 1 (sslength ss)) ;;;开始连线
(progn
(setq oldliness (ssget "x" '((0 . "line")(8 . "电气辅助线"))))
(if oldliness (command "erase" oldliness ""))
(setq ss (vl-remove ttent (ss2list ss)))
(foreach x ss
(setq px (getmidpo (entbox x)))
(command "line" "non" po "non" px "")
)
)
);;;结束连线
)
)
(setq aa (ssget "x" '((0 . "line")(8 . "电气辅助线"))))
(if (/= aa nil)
(progn
(command "chprop" aa "" "c" "2" "" ) ;;修改线的颜色
(command "layer" "m" "电" "c" "3" "电" "") ;;图层电置于当前图层
)
)
(SETVAR "CMDECHO" 1)
(princ)
)
;;单个物体的最小（正交）包围框
(defun entbox ( ent / ll ur )
(vla-getboundingbox (*ent2obj* ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
;;求两点中点
(defun getmidpo( pts / P1 P2 X Y )
(setq p1 (car pts) p2 (cadr pts))
(if (= (length p1) (length p2))
nil
(setq p1 (list (car p1) (cadr p1))
p2 (list (car p2) (cadr p2))
)
)
(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
)
;;选择集转为图元列表
(defun ss2list( ss )
(if (= 'PICKSET (type ss))
(reverse (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss))))
)
)

Answer 3

写是不难，可是没时间。毕竟还要花脑子去想。

Answer 4

重赏之下必有勇夫