删除重叠文字源码

linshiyin2 · 发表于 2012-6-1 01:05:33

本帖最后由 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)
)

;重叠的文字删除单行和多行 
;判断方式为第一点，字高和文字内容相同 
(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:47:00

本帖最后由 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 ；返回值=一个数值，理论上循环中内存不会再把表再重复显示所以应该更省时把？

184235521 · 发表于 2022-5-19 09:11:26

香远益清发表于 2020-12-1 14:31
高版本CAD的OVERKILL命令搞定，不需要这些插件。

OV只能删除重叠线段，不能删除重叠文字吧

香远益清 · 发表于 2020-12-1 14:31:29

高版本CAD的OVERKILL命令搞定，不需要这些插件。

linshiyin2 · 发表于 2012-6-1 01:12:28

数量增加，基本上运算次数为2次方增加，高手来改进一下

linshiyin2 · 发表于 2012-6-1 11:29:58

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

自己顶顶

ZZXXQQ · 发表于 2012-6-1 12:43:39

试下看：

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

CTC · 发表于 2012-6-1 12:45:09

linshiyin2 · 发表于 2012-6-1 12:51:49

ZZXXQQ 发表于 2012-6-1 12:43
试下看：
[/post]

可以，我也用while搞过，但是用的是(while (< n (sslength ss))),呵呵差一点哈哈

linshiyin2 · 发表于 2012-6-1 12:55:41

ZZXXQQ 发表于 2012-6-1 12:43
试下看：
[/post]

有一点不明白，循环里套欠循环不爽，如果有2000多个文字，但是都没有重叠，基本上还是要运算2次方的次数，时间长，有其他的好办法吗？或者，为了加速，用什么函数比较快

linshiyin2 · 发表于 2012-6-1 13:04:08

本帖最后由 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: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) 
)

linshiyin2 · 发表于 2012-6-1 13:21:26

(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选择集类型 [Set/Limits/All] <" :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)
)

(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选择集类型 [Set/Limits/All] <" :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 的源码，厉害，研究一下

c735023723 · 发表于 2012-6-1 21:16:51

很好，

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

删除重叠文字源码

相关帖子

点评

点评

点评