[编程交流] 文本操作

(defun c:fence (/ ss i tEnt tVal l1 l1list l1val l2 l2list
         l2val l3 l3list l3val l2pos l1New l2New)
 (vl-load-com)
 (if (and (setq ss (ssget (list (cons 0 "TEXT")
       (if (getvar "CTAB")
             (cons 410 (getvar "CTAB"))
           (cons 67 (- 1 (getvar "TILEMODE")))))))
      (= (setq i (sslength ss)) 3))
   (progn
     (while (not (minusp (setq i (1- i))))
   (setq tEnt (ssname ss i)
         tVal (cdr (assoc 1 (entget tEnt))))
   (cond ((wcmatch tVal "Fen*")
          (setq l1 tEnt)
          (setq l1list (entget l1))
          (setq l1val tVal))
         ((wcmatch tVal "*@*")
          (setq l2 tEnt)
          (setq l2list (entget l2))
          (setq l2val tVal))
         ((wcmatch tVal "*/*")
          (setq l3 tEnt)
          (setq l3list (entget l3))
          (setq l3val tVal))))
     (setq l2pos (vl-string-search "@" l2val)
       l1New (strcat l1val (chr 32) (substr l2val 1 l2pos))
       l2New (strcat (substr l2val (1+ l2pos)) (chr 32) l3val))
     (setq l1list (subst (cons 1 l1New) (assoc 1 l1list) l1list)
       l2list (subst (cons 1 l2New) (assoc 1 l2list) l2list))
     (entmod l1list)
     (entmod l2list)
     (entdel l3))
   (princ "\n<!> No Text Found <!>"))
 (princ))

;;__________________________________________;;
(defun dxf (key alist)
 (cdr (assoc key alist))
 )
;;__________________________________________;;
(defun ss_list        (ss / en i lst)
 (setq i -1)
 (while (setq en (ssname ss (setq i (1+ i))))
   (setq lst (cons en lst)
  )
   )
 (reverse lst)
 )
;;__________________________________________;;
(defun sort_txt_list  (lst)
 (vl-sort lst
   (function (lambda (a b)
               (< (cadr (dxf 10 (entget a)))
                  (cadr (dxf 10 (entget b)))))))
 )
;;__________________________________________;;
(defun C:txf (/ *error* com_list ctxt el el1 el2 en fst ip ll
      ocm p1 p2 pos pt pt1 pt2 ss str1 str2 tx1 tx2 tx3
      txt txt_list ur)
           (defun *error*  (msg)
      (if msg
      (if
        (not
          (member
            msg
            '("console break"
              "Function cancelled"
              "quit / exit abort"
              "")
            )
          )
         (princ (strcat "\nError: " msg))
         )
        )
      (if ocm
        (setvar "cmdecho" ocm)
        )
      (command "._zoom" "_P")
      (command "._ucs" "_P")
      (command "undo" "end")
      (prompt "\nResetting System Variables... ")
      (princ)
      ) 
(setq ocm (getvar "cmdecho"))
(command "._undo" "_BE") 
(command "._ucs" "_W")
(command "._zoom" "_E")
 
(alert "Select 3 lines of text by window\nwith small gap for using them\nlater as template")
(princ "\nSelection start")
(setq pt1 (getpoint "\nLOWER LEFT corner point: ")
      pt2 (getcorner pt1 "\nUPPER RIGHT corner point: ")
)
 
 (while (not
   (and
 (setq ss (ssget "_W" pt1 pt2
          (list (cons 0 "TEXT")
                [color=red](cons 8 "ANNO-TEXT");text layer
                (cons 7 "SHERIF");text style
                (cons 40 0.75);text size[/color]
                )
           )
)
 (= 3 (sslength ss))))
   (alert "Select 3 text only from up to down")
   )
 (setq txt_list (sort_txt_list (ss_list ss)))
 ;; absolute coordinates of selection window:
 (setq fst (car txt_list)
pt (dxf 10 (entget fst))
)
 (setq ll (mapcar '- pt1 pt)
ur (mapcar '- pt2 pt)
ss nil
)
 
 (setq ss (ssget "_X"
          (list (cons 0 "TEXT")
                (cons 1 (dxf 1 (entget fst)))
                [color=red](cons 8 "ANNO-TEXT");text layer
                (cons 7 "SHERIF");text style
                (cons 40 0.75);text size[/color]
                )
           )
)
 
 (setq com_list (ss_list ss) ss nil)
 (while (setq fst (car com_list))
 (setq pt (dxf 10 (entget fst))
p1 (mapcar '+ pt ll)
p2 (mapcar '+ pt ur)
)
 (setq ss (ssget "_W" p1 p2
          (list (cons 0 "TEXT")
                [color=red](cons 8 "ANNO-TEXT");text layer
                (cons 7 "SHERIF");text style
                (cons 40 0.75);text size[/color]
                )
           )
)
 (setq txt_list (sort_txt_list (ss_list ss))
tx1 (car txt_list)
tx2 (cadr txt_list)
tx3 (last txt_list)
el1 (entget tx1)
el2 (entget tx2)
)  
 (setq ctxt "" txt "")
 (while (setq en (car txt_list))   
   (setq el (entget en))
   (setq ip (dxf 10 el))
   (setq txt (dxf 1 el))
   (setq ctxt (strcat txt " " ctxt))
   (setq txt_list (cdr txt_list))
   )
 (setq str1 (substr ctxt (setq pos (1+ (vl-string-search "@" ctxt))))
str2 (substr ctxt 1 (+ (- (strlen ctxt) pos) 2))
)
;;;    (entdel (last txt_list))
   (entmod (subst (cons 1 str1)(assoc 1 el1) el1))
   (entupd tx1)  
   (entmod (subst (cons 1 str2)(assoc 1 el2) el2))  
   (entupd tx2)
   (command "._erase" tx3 "")
 (setq com_list (cdr com_list))
   
   )   
(*error* nil)
(princ) 
)
(princ "\nStart command with TXF")
(princ)