删除重叠文字源码
本帖最后由 linshiyin2 于 2012-6-1 11:30 编辑写了个重叠文字删除程序，但是运行有点慢，高手来改一下，实验过600个多行文字大概要20s。
;重叠的文字删除单行和多行
;判断方式为第一点，字高和文字内容相同
(defun C:deladtxt (/ dxf1 dxf10 dxf101 dxf11 dxf40 dxf401 en en_data en1 k
lis m n ss
)
(setq ss (ssget "x" '((-4 . "<OR") (0 . "TEXT")
(0 . "MTEXT")
(-4 . "OR>")
)
)
)
(setq n (- (sslength ss) 1)
m 0
k 0
)
(setq lis (ssadd))
(repeat n
(setq en (ssname ss 0))
(setq en_data (entget en))
(setq dxf10 (cdr (assoc 10 en_data))
dxf40 (cdr (assoc 40 en_data))
dxf1 (cdr (assoc 1 en_data))
)
(setq ss (ssdel en ss))
(setq k (sslength ss))
(repeat k
(setq en1 (ssname ss m))
(setq en_data (entget en1))
(setq dxf101 (cdr (assoc 10 en_data))
dxf401 (cdr (assoc 40 en_data))
dxf11 (cdr (assoc 1 en_data))
)
(if (and
(equal dxf10 dxf101)
(equal dxf40 dxf401)
(equal dxf1 dxf11)
)
(progn
(setq lis (ssadd en1 lis))
)
)
(setq m (+ m 1))
)
(setq m 0)
)
(setq m (sslength lis))
(if (> m 0)
(repeat m
(setq en (ssname lis 0))
(entdel en)
(setq lis (ssdel en lis))
)
)
(princ (strcat "删除文字个数:" (itoa m)))
(princ)
)
3楼加入了计算耗时。 本帖最后由 lisperado 于 2019-11-3 09:51 编辑
如果把 if 句里的member换成vl-position也许更快？
member vs vl-position的思维：
举例:
(setq lst '(1 2 3 4 5 6 7 8 9 0))； 这里表(list)只以10个数字来示范，表示我们会有更长的表
(member 3 lst)
;(3 4 5 6 7 8 9 0 . . . . . . .) ;返回值=表！如果while/repeat/foreach里循环很长的表会很吃力吧？
(vl-position 3 lst)
;2 ；返回值=一个数值，理论上循环中内存不会再把表再重复显示所以应该更省时把？
香远益清 发表于 2020-12-1 14:31
高版本CAD的OVERKILL命令搞定，不需要这些插件。
OV只能删除重叠线段，不能删除重叠文字吧 高版本CAD的OVERKILL命令搞定，不需要这些插件。 数量增加，基本上运算次数为2次方增加，高手来改进一下 (defun C:deladtxt (/ dxf1 dxf10 dxf101 dxf11 dxf40 dxf401 en en_data en1 k
lis m n ss
)
(setq ss (ssget "x" '((-4 . "<OR") (0 . "TEXT")
(0 . "MTEXT")
(-4 . "OR>")
)
)
)
(setq n (- (sslength ss) 1)
m 0
k 0
t0 (* 86400 (getvar "tdusrtimer"))
)
(setq lis (ssadd))
(repeat n
(setq en (ssname ss 0))
(setq en_data (entget en))
(setq dxf10 (cdr (assoc 10 en_data))
dxf40 (cdr (assoc 40 en_data))
dxf1 (cdr (assoc 1 en_data))
)
(setq ss (ssdel en ss))
(setq k (sslength ss))
(repeat k
(setq en1 (ssname ss m))
(setq en_data (entget en1))
(setq dxf101 (cdr (assoc 10 en_data))
dxf401 (cdr (assoc 40 en_data))
dxf11 (cdr (assoc 1 en_data))
)
(if (and
(equal dxf10 dxf101)
(equal dxf40 dxf401)
(equal dxf1 dxf11)
)
(progn
(setq lis (ssadd en1 lis))
)
)
(setq m (+ m 1))
)
(setq m 0)
)
(setq m (sslength lis))
(if (> m 0)
(repeat m
(setq en (ssname lis 0))
(entdel en)
(setq lis (ssdel en lis))
)
)
(setq t1 (* 86400 (getvar "tdusrtimer")))
(princ (strcat "耗时:" (rtos (- t1 t0) 2 3) " 删除文字个数:"
(itoa m)
))
(princ)
)自己顶顶 试下看：
(defun C:deladtxt (/ dxf1 dxf10 dxf101 dxf11 dxf40 dxf401 en en_data en1 k m n ss)
(setq ss (ssget "x" '((0 . "*TEXT"))))
(setq n (1- (sslength ss))
s 0
t0 (* 86400 (getvar "tdusrtimer")))
(setq lis (ssadd))
(while (> n 1)
(setq en (ssname ss 0))
(setq en_data (entget en))
(setq dxf10 (cdr (assoc 10 en_data))
dxf40 (cdr (assoc 40 en_data))
dxf1 (cdr (assoc 1 en_data)))
(setq ss (ssdel en ss))
(setq k (sslength ss))
(setq m 0)
(while (> k m)
(setq en1 (ssname ss m))
(setq en_data (entget en1))
(setq dxf101 (cdr (assoc 10 en_data))
dxf401 (cdr (assoc 40 en_data))
dxf11 (cdr (assoc 1 en_data)))
(if (and (equal dxf10 dxf101)
(equal dxf40 dxf401)
(= dxf1 dxf11))
(setq ss (ssdel en1 ss) k (1- k) s (1+ s))
(setq m (1+ m))
)
)
(setq n (1- (sslength ss)))
)
(setq t1 (* 86400 (getvar "tdusrtimer")))
(princ (strcat "耗时:" (rtos (- t1 t0) 2 3) " 删除文字个数:"
(itoa s)
))
(princ)
)
ZZXXQQ 发表于 2012-6-1 12:43 static/image/common/back.gif
试下看：
可以，我也用while搞过，但是用的是(while (< n (sslength ss))),呵呵差一点哈哈 ZZXXQQ 发表于 2012-6-1 12:43 static/image/common/back.gif
试下看：
有一点不明白，循环里套欠循环不爽，如果有2000多个文字，但是都没有重叠，基本上还是要运算2次方的次数，时间长，有其他的好办法吗？或者，为了加速，用什么函数比较快
本帖最后由 linshiyin2 于 2012-6-1 13:06 编辑
(defun C:deladtxt (/ dxf1 dxf10 dxf101 dxf11 dxf40 dxf401 en en_data en1 k
lis m n s ss t0 t1
)
(setq ss (ssget "x" '((0 . "*TEXT"))))
(setq n (1- (sslength ss))
s 0
t0 (* 86400 (getvar "tdusrtimer"))
)
(princ (strcat "\n图元个数:" (itoa n) "\n"))
(setq lis (ssadd))
(while (> n 1)
(setq en (ssname ss 0))
(setq en_data (entget en))
(setq dxf10 (cdr (assoc 10 en_data))
dxf40 (cdr (assoc 40 en_data))
dxf1 (cdr (assoc 1 en_data))
)
(setq ss (ssdel en ss))
(setq k (sslength ss))
(setq m 0)
(while (> k m)
(setq en1 (ssname ss m))
(setq en_data (entget en1))
(setq dxf101 (cdr (assoc 10 en_data))
dxf401 (cdr (assoc 40 en_data))
dxf11 (cdr (assoc 1 en_data))
)
(if (and
(equal dxf10 dxf101)
(equal dxf40 dxf401)
(= dxf1 dxf11)
)
(progn
(setq ss (ssdel en1 ss)
k (1- k)
s (1+ s)
)
(setq lis (ssadd en1 lis))
)
(setq m (1+ m))
)
)
(setq n (1- (sslength ss)))
)
(setq m (sslength lis))
(if (> m 0)
(repeat m
(setq en (ssname lis 0))
(entdel en)
(setq lis (ssdel en lis))
)
)
(setq t1 (* 86400 (getvar "tdusrtimer")))
(princ (strcat "耗时:" (rtos (- t1 t0) 2 3) " 删除文字个数:"
(itoa s)
)
)
(princ)
)
(defun C:DUPREM (/ F1 SLE SA CA TA LA LB ENTA EA TYPA A1 A2 A3 A4 SC LTEST
TES
)
(setq F1 NIL
F1 0
)
(or
:GCHOICE
(setq :GCHOICE "Set")
)
(initget "Set Limits All")
(setq SLE (getkword (strcat "\n选择集类型 <" :GCHOICE
">: "
)
)
)
(if (not SLE)
(setq SLE :GCHOICE)
(setq :GCHOICE SLE)
)
(cond
((= SLE "Set")
(setq SA (ssget))
)
((= SLE "Limits")
(setq SA (ssget "c" (getvar "extmin") (getvar "extmax")))
)
((= SLE "All")
(setq SA (ssget "X"))
)
)
(if (and
SA
(= (type SA) 'PICKSET)
(not (zerop (sslength SA)))
)
(progn
(setq CA 0
TA (sslength SA)
LA NIL
LB NIL
)
(while (< CA TA)
(setq ENTA (ssname SA CA)
EA (cdr (entget ENTA))
TYPA (cdr (assoc 0 EA))
)
(setq A1 (assoc 5 EA))
(setq A2 (cons 5 ""))
(setq EA (subst
A2
A1
EA
)
)
(if (wcmatch (getvar "ACADVER") "*15*")
(progn
(setq A3 (assoc 330 EA))
(setq A4 (cons 330 ""))
(setq EA (subst
A4
A3
EA
)
)
)
)
(setq LA (cons ENTA LA)
LB (cons EA LB)
CA (+ CA 1)
)
)
(setq SC NIL
SC (ssadd)
LTEST LB
)
(setq CA 0)
(setq TES (car LTEST)
LTEST (cdr LTEST)
TA NIL
TA (length LTEST)
)
(while (/= TA 0)
(if (member TES LTEST)
(progn
(setq SC (ssadd (nth CA LA) SC))
(setq F1 (+ F1 1))
)
)
(setq CA (+ CA 1))
(setq TES (car LTEST)
LTEST (cdr LTEST)
TA (length LTEST)
)
)
(command "erase" SC "")
(redraw)
(prompt "\n")
(prin1 F1)
(prompt " 个物体被删除.")
)
)
(princ)
)
Gu_xl 的源码，厉害，研究一下 很好，