[编程交流] 顺序查找/替换？

;;;Routine for Renumbering<p>;;;Realization {Smirnoff}</p><p>;;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=29829Am</p><p>;;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=21807yD</p><p>;;;Edition 23.10.2006 Vladimir Azarko (VVA)</p><p>;;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=30394Ae</p><p>(defun c:renum (/ oldPref oldSuf oldStart curText curStr vlaObj keepText)</p><p>(vl-load-com)</p><p>(defun TTC_Paste(pasteStr keepText / nslLst vlaObj)</p><p>(if (setq nslLst(nentsel "\nPaste text <exit> >>"))</exit></p><p>(progn (cond</p><p>((and (= 4(length nslLst))</p><p> (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and</p><p>(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))</p><p>(setq oldStat (vla-get-Measurement vlaObj))</p><p>(if keepText</p><p> (if (= (vla-get-TextOverride vlaObj) "")</p><p> (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))</p><p> (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))</p><p>(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))</p><p> (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1</p><p>((and (= 4(length nslLst))</p><p>(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and</p><p>(setq vlaObj (vlax-ename->vla-object(car nslLst)))</p><p>(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))</p><p>(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))</p><p>(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2</p><p>((and (= 4(length nslLst))</p><p> (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and</p><p>(princ "\nCan't paste to block's DText or MText. ")); end condition #3</p><p>((and (= 2(length nslLst))</p><p>(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and</p><p>(setq vlaObj (vlax-ename->vla-object(car nslLst)))</p><p>(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))</p><p>(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))</p><p>(princ "\nError. Can't pase text. "))); end condition #4</p><p>(T (princ "\nCan't paste. Invalid object. ")); end condition #5</p><p>); end cond</p><p>T); end progn</p><p>nil); end if</p><p>);_TTC_PASTE</p><p>(setq aDoc(vla-get-ActiveDocument(vlax-get-acad-object)))</p><p>(vla-StartUndoMark aDoc)</p><p>(if(not rnm:Pref)(setq rnm:Pref ""))(if(not rnm:Suf)(setq rnm:Suf ""))</p><p>(if(not rnm:Start)(setq rnm:Start 1))</p><p>(setq oldPref rnm:Pref oldSuf rnm:Suf oldStart rnm:Start); end setq</p><p>(setq rnm:Pref (getstring T (strcat "\nType prefix: : ")))</p><p>(if(= "" rnm:Pref)(setq rnm:Pref oldPref))(if(= " " rnm:Pref)(setq rnm:Pref ""))</p><p>(setq rnm:Suf (getstring T (strcat "\nType suffix: : ")))</p><p>(if(= "" rnm:Suf)(setq rnm:Suf oldSuf));(if(= " " rnm:Suf)(setq rnm:Suf ""))</p><p>(setq rnm:Start (getint (strcat "\nEnter start number </p><p>(itoa rnm:Start)">: ")))</p><p>(if(null rnm:Start)(setq rnm:Start oldStart))</p><p>(initget "Yes No Ä</p>

(defun c:cx() ;;Edits text objects by replacing current text with a prefix and an incremental numerical suffix
 (setq prefix (getstring "Prefix:")) ;; prompts the user for the string prefix
 (setq startint (getint "Initial number:")) ;; prompts the user for the initial number
 (setq cnt 0) ;; intializes the counter
 (while
   (PROGN
     (setq ent (entsel)) ;;requests the first text to edit
     (setq newstring (strcat prefix (itoa (+ startint cnt)))) ;;created the string
     (command "change" (car ent) "" "" "" "" "" "" newstring) ;;replace the string
     (setq cnt (1+ cnt)) ;; increment the counter
    )
  )
 )

;; ============================================================ ;;
;;                                                              ;;
;;  RENUM.LSP - This program converts TEXT, MTEXT and  ;;
;;              ATTRIBUTES in numbers with a prefix and  ;;
;;              a suffix.     ;;
;;                                                           ;;
;; ============================================================ ;;
;;                                                             ;;
;;  Command(s) to call: RENUM                                   ;;
;;                                                             ;;
;;  Specify a suffix, a prefix and starting number (for erase  ;;
;;  the old suffix or prefix you should press Spacebar). Pick  ;;
;;  to TEXT, MTEXT, ATTRIBUTES or press Esc to quit. The  ;;
;;  program remembers old properties and it is possible to  ;;
;;  confirm it pressing of Spacebar key.   ;;
;;                                                              ;;
;; ============================================================ ;;
;;                                                              ;;
;;  THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ;;
;;  ON ANY MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS ;;
;;  PROGRAM OR PARTS OF IT ABSOLUTELY FREE.                  ;;
;;                                                              ;;
;;  THIS PROGRAM PROVIDES THIS PROGRAM 'AS IS' WITH ALL FAULTS ;;
;;  AND SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF  ;;
;;  MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.            ;;
;;                                                             ;;
;; ============================================================ ;;
;;                                                              ;;
;;  V1.3, 12 May, 2005, Riga, Latvia                            ;;
;;  © Aleksandr Smirnov (ASMI)                           ;;
;;  For AutoCAD 2000 - 2008 (isn't tested in a next versions) ;;
;;                                                              ;;
;;                             [url]http://www.asmitools.com[/url]    ;;
;;                                                             ;;
;; ============================================================ ;;
(defun c:renum (/ oldPref oldSuf oldStart curText curStr) 
 (vl-load-com) 
 (if(not rnm:Pref)(setq rnm:Pref "")) 
 (if(not rnm:Suf)(setq rnm:Suf "")) 
 (if(not rnm:Start)(setq rnm:Start 1)) 
 (setq oldPref rnm:Pref 
       oldSuf rnm:Suf 
       oldStart rnm:Start); end setq 
 (setq rnm:Pref 
   (getstring T 
     (strcat "\nPrefix: <"rnm:Pref">: "))) 
 (if(= "" rnm:Pref)(setq rnm:Pref oldPref)) 
 (if(= " " rnm:Pref)(setq rnm:Pref "")) 
 (setq rnm:Suf 
   (getstring T 
     (strcat "\nSuffix: <"rnm:Suf">: "))) 
 (if(= "" rnm:Suf)(setq rnm:Suf oldSuf)) 
 (if(= " " rnm:Suf)(setq rnm:Suf "")) 
 (setq rnm:Start 
   (getint 
     (strcat "\nStarting number <" 
        (itoa rnm:Start)">: "))) 
 (if(null rnm:Start)(setq rnm:Start oldStart))
    (while T 
      (setq curStr(strcat rnm:Pref(itoa rnm:Start)rnm:Suf)) 
        (setq curText 
          (car 
            (nentsel
  "\n<<< Pick TEXT, MTEXT or ATTRIBUTE or press Esc to quit >>> "))) 
      (if 
        (and 
          curText 
          (member(cdr(assoc 0(entget curText)))
        '("TEXT" "MTEXT" "ATTRIB")) 
          ); end and 
        (progn
   (if
     (vl-catch-all-error-p
       (vl-catch-all-apply 'vla-put-TextString
  (list(vlax-ename->vla-object curText)curStr)))
      (princ "\n<!> Entity on locked layer <!>") 
             (setq rnm:Start(1+ rnm:Start))
     ); end if
        ); end progn 
       (princ "\n<!> This is not DText or MText <!>") 
       ); end if 
      ); end while 
  (princ) 
 ); end of c:renum
(princ
 (strcat "\n*** Text, MText or Attributes"
         " numbering tool. Type RENUM to run.*** "))