[编程交流] 计数属性+1

 <p>;; Increment Text lisp routine</p><p>;;</p><p>;; by: Irné Barnard</p><p>;; Version 1.2</p><p>;; </p><p>;; Version history</p><p>;; ==================================</p><p>;; 1.2</p><p>;; Added alphabetic increments</p><p>;;</p><p>;; 1.1</p><p>;; Add prefix / suffix</p><p>;; Add minimum digits</p><p>;;</p><p>;; 1.0</p><p>;; Initial version</p><p>;;</p><p>(setq INCRset  '(1 "" "" 1 1 t)</p><p>      alphalst</p><p>        '("A" "B" "C" "D" "E" "F" "G" "H" "J" "K" "L" "M" "N" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"</p><p>  )</p><p>) ;_ end of setq</p><p>;; Utility function to convert alpha number to integer</p><p>;|(defun alphatoi (a / i neg n)</p><p>  (if (setq neg (= "-" (substr a 1 1)))</p><p>    (setq a (substr a 2))</p><p>  )</p><p>  (setq i a n (strlen i) a "")</p><p>  (while (> n 0)</p><p>    (setq a (strcat a (substr i n 1)) n (1- n))</p><p>  )</p><p>  (setq i 0 n 1)</p><p>  (while (</p><p>    (if (= n (strlen a))</p><p>      ()</p><p>      (setq i (+ i (* (vl-position (1- n) )</p><p>    )</p><p>    (setq n (1+ n))</p><p>  )</p><p>  (if neg (setq i (* i -1)))</p><p>  i</p><p>)</p><p>|;</p><p>;; Utility function to convert integer to Alpha number</p><p>(defun itoalpha (i / a neg)</p><p>  (setq neg (</p><p> i   (abs (fix i))</p><p> a   ""</p><p>  ) ;_ end of setq</p><p>  (while (>= i 0)</p><p>    (setq a (strcat (nth (rem i (length alphalst)) alphalst) a))</p><p>    (setq i (- i (rem i (length alphalst))))</p><p>    (setq i (fix (/ i (length alphalst))))</p><p>    (if (= i 0)</p><p>      (setq i -1)</p><p>      (if (/= (rem i) 0)</p><p> (setq i (1- i))</p><p>      ) ;_ end of if</p><p>    ) ;_ end of if</p><p>  ) ;_ end of while</p><p>  (if neg</p><p>    (setq a (strcat "-" a))</p><p>  ) ;_ end of if</p><p>  a</p><p>) ;_ end of defun</p><p>;; Command to increment text values by picking</p><p>(defun c:Increment (/ dcl_id obj objid id quit rate start value prfx sufx digits numerals)</p><p>  (setq start  (nth 0 INCRset)</p><p> prfx  (nth 1 INCRset)</p><p> sufx  (nth 2 INCRset)</p><p> rate  (nth 3 INCRset)</p><p> digits  (nth 4 INCRset)</p><p> numerals (nth 5 INCRset)</p><p>  ) ;_ end of setq</p><p>  (defun Setup ()</p><p>    (setq DCL_ID (load_dialog "Increment.DCL"))</p><p>    (if (not (new_dialog "increment" DCL_ID))</p><p>      (exit)</p><p>    ) ;_ end of if</p><p>    (defun CHECKOUT ()</p><p>      (setq start (atoi (get_tile "start")))</p><p>      (setq prfx (get_tile "prefix")</p><p>     sufx (get_tile "sufix")</p><p>      ) ;_ end of setq</p><p>      (setq rate (if (= (atoi (get_tile "one")) 1)</p><p>     "1"</p><p>     (if (= (atoi (get_tile "two")) 1)</p><p>       "2"</p><p>       "0"</p><p>     ) ;_ end of if</p><p>   ) ;_ end of if</p><p>      ) ;_ end of setq</p><p>      (setq rate (atoi (if (/= (atoi (get_tile "increase")) 1)</p><p>    (strcat "-" rate)</p><p>    rate</p><p>         ) ;_ end of if</p><p>   ) ;_ end of atoi</p><p>      ) ;_ end of setq</p><p>      (setq digits (atoi (get_tile "digits")))</p><p>      (setq numerals (= (get_tile "num") "1"))</p><p>      (setq INCRset (list start prfx sufx rate digits numerals))</p><p>    ) ;_ end of defun</p><p>    (defun DONE ()</p><p>      (setq quit 1)</p><p>    ) ;_ end of defun</p><p>    (if (/= start nil)</p><p>      (set_tile "start" (itoa start))</p><p>    ) ;_ end of if</p><p>    (if (/= prfx nil)</p><p>      (set_tile "prefix" prfx)</p><p>    ) ;_ end of if</p><p>    (if (/= sufx nil)</p><p>      (set_tile "sufix" sufx)</p><p>    ) ;_ end of if</p><p>    (if (/= digits nil)</p><p>      (set_tile "digits" (itoa digits))</p><p>    ) ;_ end of if</p><p>    (if numerals</p><p>      (set_tile "num" "1")</p><p>      (set_tile "alpha" "1")</p><p>    ) ;_ end of if</p><p>    (if (/= rate nil)</p><p>      (progn</p><p> (cond</p><p>   ((= rate 0) (set_tile "none" "1"))</p><p>   ((= rate 2) (set_tile "two" "1"))</p><p>   ((= rate -2) (set_tile "two" "1") (set_tile "decrease" "1"))</p><p>   ((= rate -1) (set_tile "decrease" "1"))</p><p> ) ;_ end of cond</p><p>      ) ;_ end of progn</p><p>    ) ;_ end of if</p><p>    (action_tile "accept" "(CHECKOUT)(done_dialog)")</p><p>    (action_tile "cancel" "(DONE)(done_dialog)")</p><p>    (start_dialog)</p><p>    (unload_dialog DCL_ID)</p><p>  ) ;_ end of defun</p><p>  (SETUP)</p><p>  (while (/= quit 1)</p><p>[color=red]    (while (and (/= quit 1) (not (or (= id "TEXT") (= id "MTEXT") (= id "ATTRIB"))))[/color]</p><p>      (setq obj nil)</p><p>      (if numerals</p><p> (progn</p><p>   (setq value (itoa start))</p><p>   (while (</p><p> ) ;_ end of progn</p><p> (progn</p><p>   (setq value (itoalpha start))</p><p>   (while (</p><p> ) ;_ end of progn</p><p>      ) ;_ end of if</p><p>      (while (and (/= quit 1) (= obj nil))</p><p> (setvar "errno" 0)</p><p> (initget 4 "Change")</p><p> (setq obj (nentsel (strcat "\rSelect text...(" value ")[Change]")))</p><p> (cond</p><p>   ((= (getvar "errno") 52)</p><p>    (setq quit 1</p><p>   obj 1</p><p>    ) ;_ end of setq</p><p>   )</p><p>   ((= obj "Change") (Setup) (setq obj nil))</p><p>   ((/= obj nil) (setq objid (entget (car obj))) (setq id (cdr (assoc 0 objid))))</p><p> ) ;_ end of cond</p><p>      ) ;_ end of while</p><p>    ) ;_ end of while</p><p>    (if (/= quit 1)</p><p>      (progn</p><p> (setq objid (subst (cons 1 (strcat prfx value sufx)) (assoc 1 objid) objid))</p><p> (entmod objid)</p><p> (command "_updatefield" (car obj) "")</p><p> (entupd (car obj))</p><p> (setq INCRset (list start prfx sufx rate digits numerals))</p><p> (setq start (+ start rate))</p><p> (setq id nil)</p><p> (setq obj nil)</p><p>      ) ;_ end of progn</p><p>    ) ;_ end of if</p><p>  ) ;_ end of while</p><p>  (princ)</p><p>) ;_ end of defun</p><p>;;; ROUND Arrondit </p>