Question

autocad的lisp，程序检查是否有重叠的文字，我用的是，选择相同的文字内容，及相同的坐标来判断。

不知道还有别的方法吗？这个程序检查1500个文字需要40多秒，能不能精简过程，提高运行速度？
(defun C:MJHF35 ( / &kw ss1 $k1 &kw1)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setq $k1 0)
(setq &kw (entsel "\n请选择要检查文字的参考图层"))
(if (/= &kw nil)
(progn
(setq &kw (car &kw) &kw (entget &kw) &kw (cdr (assoc 8 &kw)))
(setq &kw1 (ssget "X" (list (cons 8 &kw) (cons 0 "TEXT,MTEXT"))))
(if (/= &kw1 nil) (setq ss1 (MJHF36 &kw1) $k1 (sslength ss1)) )
(if (/= $k1 0) (setq ss1 (MJHF37 ss1)) )
)
)
(if (= $k1 0) (alert "\n没有重叠的文字") )
(if (/= $k1 0) (sssetfirst nil ss1) (pause) )
)
;;;;检查文字子程序;;;;;
(defun MJHF36 (&kw1 / ss1 i %k1 %k2 #k1 #k2 n L %k3 %k4 #k3 #k4 $k1 $k2 $k3 $k4 L1)
(setq ss1 (ssadd) i 0 &kw2 &kw1)
(repeat (sslength &kw1)
(setq %k1 (ssname &kw1 i) i (+ i 1) %k2 (entget %k1) #k1 (cdr (assoc 1 %k2)) #k2 (cdr (assoc 10 %k2)) $k1 (car #k2) $k2 (cadr #k2) n 0 L 0 L1 0)
(repeat (sslength &kw2)
(setq %k3 (ssname &kw2 n) n (+ n 1) %k4 (entget %k3) #k3 (cdr (assoc 1 %k4)) #k4 (cdr (assoc 10 %k4)) $k3 (car #k4) $k4 (cadr #k4))
(if (and (= #k1 #k3) (= $k1 $k3) (= $k2 $k4)) (setq L (+ L 1)) )
(if (and (= L1 0) (= L 2)) (setq ss1 (ssadd %k1 ss1) L1 (+ L1 1)) )
)
)
ss1
)
还有一段删除重复的文字发送不上来，如果删除了一句话，(if (/= $k1 0) (setq ss1 (MJHF37 ss1)) ) ；那么会把两个重复的都选择了，我需要选择一个，

Answer 1

已解决（检查文字程序代码），望采纳：
(defun MJHF36 ($myss / ss2 fn %k2 #k1 #k2 $k1 $k2 n %k4 #k3 #k4 $k3 $k4)
(setq ss2 (ssadd))
(while (and (/= (sslength $myss) 1) (/= (sslength $myss) 0))
(setq fn (ssname $myss 0))
(setq %k2 (entget fn)
#k1 (cdr (assoc 1 %k2))
#k2 (cdr (assoc 10 %k2))
$k1 (car #k2)
$k2 (cadr #k2)
n 0
)
(ssdel fn $myss)
(repeat (sslength $myss)
(setq %k3 (ssname $myss n)
%k4 (entget %k3)
#k3 (cdr (assoc 1 %k4))
#k4 (cdr (assoc 10 %k4))
$k3 (car #k4)
$k4 (cadr #k4)
n (+ n 1)
)
;;; (if (= #k1 #k3)
(if (and (= #k1 #k3) (= $k1 $k3) (= $k2 $k4))
(progn
(setq ss2 (ssadd %k3 ss2))
(ssdel %k3 $myss)
(setq n(1- n))
)
)
)
)
ss2
)

追问

你的方法我试了，每检查一个文字，就删除一个文字，理论上是精简了。我调试了一下可以使用了。不知道还有没有更好的办法？

追答

加我的群吧，发个参考程序，你看看有没有对你有所帮助。（315707138）

Answer 2

飘过，无法理解