8-10 tcm.lsp=text cut & merge(문자 자르기 & 합치기)->추가(2007.3)

  8-10 tcm.lsp=text cut & merge(문자 자르기 & 합치기)->추가(2007.3)
            문자을 선택하여 2개로 나누거나 두 개의 문자을 1개로 합치는 명령어

 

;;==================================
;  문자 자를기 & 합치기 (2007.3 주말농부)
;  ->tcm.lsp=text cut & merge
;;----------------------------------------
(defun c:tcm(/ kw)
  (prompt " Text Cutting & Merge...")
  (initget "Cutting Merge")
  (setq kw (getkword "\n문자편집선택 [자르기(Cutting) / 합치기(Merge)] <자르기>: "))
  (if (= kw nil) (setq kw "Cutting"))
  (cond ((= kw "Cutting") (@txtcut) )
          ((= kw "Merge") (@txtmerge) )
          ((= kw ""  )  (princ)  )
  )
  (prin1)
)
;text cut
(defun @txtcut (/ ss en1 oldtxt sn st txt osl nsl tno ox condi txt1 txt2 h ang en2 t_sub_txt len)
   (setvar "cmdecho" 0)  (setq ss nil)
   (while (= ss nil) (setq ss (ssget ":s" (list (cons 0 "text"))))  )
      (setq en1 (ssname ss 0))
      (setq oldtxt (cdr (assoc 1 (entget en1))))
      (setq sn (cdr (assoc 7 (entget en1))))
      (setq st t)
      (while st
         (setq txt (getstring "\n분리될 첫단어: "))
         (if txt   (setq st nil) )
      )
      (setq osl (strlen oldtxt))
      (setq nsl (strlen txt))
      (setq tno 1) (setq st t)
      (while (and st (< tno osl))
             (setq ox (substr oldtxt tno nsl))
             (if (= ox txt)
                 (setq st nil condi t)
                 (setq tno (1+ tno))
             )
      )
      (if condi
          (progn
             (setq txt1 (substr oldtxt 1 (- tno 1)))
             (setq txt2 (substr oldtxt tno (- osl (- tno 1))))
             (setq h (cdr (assoc 40 (entget en1))))
             (setq ang (cdr (assoc 50 (entget en1))))
             (command "copy" en1 "" (list 0.0 0.0 0.0)
                      (polar (list 0.0 0.0 0.0) (- ang (/ pi 2.0)) (* h 2.0))
             )
             (setq en2 (ssname (ssget "l") 0))
             (setq t_sub_txt (strcase (substr txt1 1 3)))
             (if (= (strcase t_sub_txt) "%%U") (setq txt1 (strcat txt1 "%%u")) )
             (entmod (subst (cons 1 txt1) (assoc 1 (entget en1)) (entget en1) )  )
             (setq len (strlen txt2))
             (setq t_sub_txt (strcase (substr txt2 (- len 2) 3)))
             (if (= (strcase t_sub_txt) "%%U") (setq txt2 (strcat "%%u" txt2))  )
             (entmod (subst (cons 1 txt2) (assoc 1 (entget en2)) (entget en2) )  )
          )
      )
)
;text merge
(defun @txtmerge (/ en1 en2 elist1 elist2 plist1 tx1 tx2 tx3)
    (setvar "cmdecho" 0)
    (setq elist1 (entget (car (entsel "\n첫번째 문자: "))))
    (setq  en2 (car (entsel "\n두번째 문자: ")))
    (setq en1 (cdr (assoc -1 elist1)))
    (setq  elist2 (entget en2))
    (if (not (equal en1 en2)) (progn
        (setq plist1 (assoc 1 elist1))
        (setq tx1 (cdr plist1))
        (setq tx2 (cdr (assoc 1 elist2)))
        (setq tx3 (strcat tx1 tx2))
        (entmod (subst (cons 1 tx3) plist1 elist1))
        (command "erase" en2 "")   )
    )
)

tcm.lsp

0.00MB