리습이 텍스트중복을찾아체크해주는 리습인데 혹시 수정해서 블럭중복도 체크해서 찾을수있게끔 가능한지요 고수님들
컨텐츠 정보
- 221 조회
- 0 추천
- 0 비추천
-
목록
본문
리습이 텍스트중복을찾아서 빨간색으로체크해주는 리습인데
혹시 수정해서 블럭중복도 체크해서 찾을수있게끔 가능한지요 고수님들
(setvar "osmode" 0) ;텍스트중복및라인에이력이2개인것찾는리습
(setq ptlist nil)
(princ "nSelect block objects.")
(defun c:asd (/ ents ent entl entsa entsb i ix n nx key txt0 txt1 key2)
(setq ents (ssget (list (cons 0 "TEXT"))))
(command "undo" "group")
(setvar "cmdecho" 0)
(defun prog-bar (a b / c)
(setq c (strcat (rtos (* (/ (- b (+ a 0.0)) b) 100) 2 1) "%"))
(vl-cmdf "MODEMACRO" c)
)
(setq i 0)a
(setq n (sslength ents))
(setq key T
entsa (ssadd)
entsb (ssadd)
)
(while key
(setq txt0 (cdr (assoc 1 (entget (setq ent0 (ssname ents 0))))))
(setq i 1
key2 nil
)
(repeat (- (sslength ents) 1)
(setq txt1 (cdr (assoc 1 (entget (setq ent (ssname ents i))))))
(if (or (= txt1 txt0) (= (@sdele txt1) (@sdele txt0)))
(progn (setq entsa (ssadd ent entsa)) (setq key2 T))
(setq entsb (ssadd ent entsb))
)
(setq i (1+ i))
)
(if key2
(progn
(setq entsa (ssadd ent0 entsa))
(setq ix 0)
(vl-cmdf "_.change" entsa "" "P" "C" 1 "")
(repeat (sslength entsa)
(setq ents (ssdel (ssname entsa ix) ents))
(setq ix (1+ ix))
)
(setq entsa (ssadd))
)
(setq ents (ssdel ent0 ents))
)
(if (= (setq nx (sslength ents)) 0)
(setq key nil)
)
(prog-bar nx n)
)
(command "undo" "end")
)
(defun @sdele (txt / k newascii @1 ascii_list newtxt) ;공백제거
(setq ascii_list (vl-string->list txt))
(setq k 0
newascii '()
)
(repeat (length ascii_list)
(setq @1 (nth k ascii_list))
(if (/= @1 32)
(setq newascii (append newascii (list @1)))
)
(setq k (1+ k))
)
(setq newtxt (vl-list->string newascii))
newtxt
)