[编程交流] 帮助删除文本重叠PIN

(defun c:FText (/ ent ent1 i lst newlayer ofset ss ss1 ss_tmp ans)
;|By Gia Bach 2010|;
(defun GetBound (ent ofs / ang elist ll lr tb tb1 tb2 ul ur)
(setq elist (entget ent)
ang (cdr (assoc 50 elist))
tb (textbox elist)
tb1 (car tb)
tb2 (cadr tb)
ll (polar (cdr (assoc 10 elist))
(+(angle '(0 0) tb1) ang) (DISTANCE '(0 0) tb1))
lr (polar ll ang (- (car tb2) (car tb1)))
ur (polar ll (+ ang (angle tb1 tb2)) (distance tb1 tb2))
ul (polar ll (+ ang (/ pi 2)) (- (cadr tb2) (cadr tb1))) )
(setq ang (angle ll lr) )
(setq ll (polar ll (- ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2)))
lr (polar lr (- ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))
ur (polar ur (+ ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))
ul (polar ul (+ ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2))) )
(list ll lr ur ul))
(command "_.undo" "be")
(setq ss (ssget (list (cons 0 "TEXT"))) ss1 (ssadd) )
(or *ofset (setq *ofset 0.5))
(initget 4)
(setq ofset (getreal (strcat "\nDistance Textbox offset: <" (rtos *ofset) ">")))
(if (= ofset nil) (setq ofset *ofset) (setq *ofset ofset))
(while (> (sslength ss) 0)
(setq ent (ssname ss 0)
lst (GetBound ent ofset) )
(ssdel ent ss)
(if (setq ss_tmp (ssget "cp" lst (list(cons 0 "TEXT"))))
(progn
(setq i -1)
(while (setq ent1 (ssname ss_tmp (setq i (1+ i))))
(if (not (equal ent ent1))
(progn
(ssadd ent1 ss1)
(if (ssmemb ent1 ss) (ssdel ent1 ss)) ))) ) ) )
(if (> (sslength ss1) 0)
(progn
(setq newlayer "Text_Filter")
(if (not (tblsearch "layer" newlayer))
(command "-layer" "n" newlayer "c" 2 newlayer "") )
(command "change" ss1 "" "p" "la" newlayer "") ) )
(setq ans (getstring "\n Do you want to Erase all of Dup Text ? [Y/N] <Y>"))
(if (or (= ans "") (not ans) (= (strcase ans) "Y")) (command ".erase" ss1 "") T)
(command "_.undo" "e")
(princ))