프로그램
캐드 분류

리습이 텍스트중복을찾아체크해주는 리습인데 혹시 수정해서 블럭중복도 체크해서 찾을수있게끔 가능한지요 고수님들

컨텐츠 정보

본문

리습이 텍스트중복을찾아서 빨간색으로체크해주는 리습인데
혹시 수정해서 블럭중복도 체크해서 찾을수있게끔 가능한지요 고수님들


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

관련자료

댓글 0
등록된 댓글이 없습니다.
여분필드1 여분필드2 여분필드3
전체 70 / 4 페이지
번호
제목
이름
알림 0