[编程交流] 需要帮助才能更改脚本o

(defun DXF (code elist)
; finds the association pair, strips 1st element
   (cdr (assoc code elist))
)
(princ)
(defun c:CEL (/ me ce hl rm bm bmoff dprec i j en ed ety lay ss len etxt wtxt elen pretxt txt posttxt ex ey ez ntxt nz old new nxyz mod)
(prompt "\n\nChange Bench Mark for Annotation Text  v2.2      2/10/93")
;
  (setq me (getvar "menuecho"))
  (setvar "menuecho" 0)
  (setq ce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq rm (getvar "regenmode"))
  (setvar "regenmode" 0)
  (setq bm (getvar "blipmode"))
  (setvar "blipmode" 0)
;  Prompt for bench mark offset
   (print)
   (initget 1)
   (setq bmoff (getreal "\nEnter value for bench mark offset, <0> to exit? "))
   (if (/= bmoff 0)
       (progn
           (initget 1)
            (setq dprec (getint "Enter decimal precision for annotation? "))
            (prompt "\n\nBench Mark Offset value:            ")(princ bmoff)
            (prompt   "\nDecimal precision on annotation:    ")(princ dprec)
;  Locate text to change and select all text on that layer
; prompt user to pick text entity
       
;  Create selection set of all annotation text entities
              (setq ss (ssget (list (cons 0 "TEXT"))))
;  Process text and modify based on bench mark offset
           (setq i 0
                 mod 0)
           (setq len (sslength ss))
           (while (< i len)
               (setq en (ssname ss i)
                       ed (entget en)
                       txt ""
                       pretxt ""
                       posttxt ""
                       noproc 0)
                   (setq etxt (dxf 1 ed))
                   (setq wtxt etxt)
                 (setq ex (car (dxf 10 ed)))
                 (setq ey (cadr (dxf 10 ed)))
                 (setq ez (caddr (dxf 10 ed)))
               (setq elen (strlen etxt))
               (setq j 1)
; Locate PRE-text
               (if (not (member (substr etxt j 1) '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" ".")))
                   (progn
                       (while (< j  (1+ elen))
                           (if (not (member (setq cc (substr etxt j 1)) '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" ".")))
                               (setq j (1+ j))
                               (progn
                                   (setq pretxt (substr etxt 1 (- j 1)))
                                   (setq etxt (substr etxt j elen))
                                   (setq j (+ elen 2))
                                   (setq noproc 1)
                               );progn
                           );if
                       );while
                       (if (= j (1+ elen))
                           (setq noproc 1)
                       );if
                   );progn
                   (setq pretxt "")
               );if
;
; Locate text to modify
;
               (setq j 1)
               (setq elen (strlen etxt))
               (if (> elen 0)
                   (progn
                       (while (< j  (1+ elen))
                           (if (member (setq cc (substr etxt j 1)) '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" "."))
                               (setq j (1+ j))
                               (progn
                                   (if (member cc '(""" "\'"))
                                       (progn
                                           (setq noproc 1)
                                           (setq j (1+ elen))
                                       );progn
                                       (progn
                                           (setq txt (substr etxt 1 (- j 1)))
                                           (setq posttxt (substr etxt j elen))
                                           (setq j (1+ elen))
                                       );progn
                                   );if
                               );progn
                           );if
                           (if (= j elen)
                               (progn
                                   (setq txt etxt)
                                   (setq posttxt "")
                               );progn
                           );if
                       );while
                   );progn
               );if
;
; Add BM Change
;
                    (if (= noproc 0)
                        (progn
                            (setq ztxt (rtos (+ (atof txt) bmoff) 2 dprec))
                         (setq ntxt (strcat pretxt ztxt posttxt))
                       (setq nz (+ ez bmoff))
;
;  Modifying entity data
;
                       (setq old (assoc 1 ed))
                       (setq new (cons 1 ntxt))        ; Text value
                       (setq ed (subst new old ed))
                       (setq ed (subst new old ed))
                       (entmod ed)
                       (setq mod (1+ mod))
                   );progn
                   (progn
                   );progn
               );if
               (setq i (+ i 1))
              );while
       ) ;progn
;
; result to BM OFFSET = 0
;
       (prompt "\n\nProgram terminated.  ")
   );endif
   (princ "\n\nThere were ")(princ len)(princ " entities processed and ")
       (princ mod)(princ " entities modified.")
; reset system variables
   (setvar "regenmode" rm)
   (setvar "blipmode" bm)
   (setvar "cmdecho" ce)
   (setvar "menuecho" me)
   (princ)
) ;End of CEL

(defun c:Text_Inc (/ *error* ParseNumbers uFlag ss)
(vl-load-com)
;; Lee Mac ~ 10.03.10
(defun *error* (msg)
(setvar 'NOMUTT 0)
(and uFlag (vla-EndUndoMark *doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(defun ParseNumbers (str / lst Num Aph x rtn)
;; Lee Mac ~ 20.09.09
(setq lst (vl-string->list str) Num "" Aph "")
(while (setq x (car lst))
(setq lst (cdr lst))
(cond ( (and (/= "" Num) (= 46 x))
(setq Num (strcat Num (chr x))))
( (< 47 x 58)
(setq Num (strcat Num (chr x))
rtn (cons Aph rtn) Aph ""))
(t (setq Aph (strcat Aph (chr x))
rtn (cons (read Num) rtn) Num ""))))
(vl-remove nil
(vl-remove "" (reverse (cons Aph (cons (read Num) rtn))))))
(setq *inc* (cond (*inc*) (1.0)))
(setq *inc* (cond ((getreal (strcat "\nSpecify Increment <"
(vl-princ-to-string *inc*) "> : ")))
(*inc*)))
(setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))))
(setvar 'NOMUTT 1)
(princ "\nSelect Text to Increment <All> : ")
(if (or (ssget "_:L" '((0 . "MTEXT,TEXT")))
(ssget "_X" '((0 . "MTEXT,TEXT"))))
(progn
(setq uFlag (not (vla-StartUndoMark *doc)))
(vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))
(vla-put-TextString obj
(apply (function strcat)
(mapcar
(function
(lambda (x) (if (vl-position (type x) '(INT REAL))
(rtos (+ x *inc*) (getvar 'LUNITS) 3) x)))
(ParseNumbers (vla-get-TextString obj))))))
(vla-delete ss)
(setq uFlag (vla-EndUndoMark *doc)))) 
(setvar 'NOMUTT 0)
(princ))

(defun c:lastattnumaddition ( / f-MR numstrchk ss n i bl str splitstr lastnumber pref newpref newstr attlst )
 (vl-load-com)
 (defun f-MR ( d s / d1 dl k ss c pl z l )
   (while (and (setq d1 (substr d 1 1)) (/= d1 ""))
     (setq d (substr d 2))
     (setq dl (cons d1 dl))
   )
   (foreach d1 dl
     (setq k -1 ss s)
     (while (and (setq c (substr ss 1 1)) (/= c ""))
       (setq ss (substr ss 2))
       (setq k (1+ k))
       (if (= c d1)
         (setq pl (cons k pl))
       )
     )
   )
   (if pl
     (progn
       (setq pl (vl-sort pl '<))
       (foreach p pl
         (if (null z)
           (setq z 1)
         )
         (setq l (cons (substr s z (1+ (- p z))) l))
         (setq z (+ p 2))
       )
       (setq l (cons (substr s z) l))
       (vl-remove "" (reverse l))
     )
     s
   )
 )
 (defun numstrchk ( s / ss ssl )
   (while (and (setq ss (substr s 1 1)) (/= ss ""))
     (setq s (substr s 2))
     (setq ssl (cons ss ssl))
   )
   (vl-every '(lambda ( x ) (vl-position x '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))) ssl)
 )
 (prompt "\nSelect blocks to perform operation on...")
 (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
 (if ss
   (progn
     (initget 3)
     (setq n (getint "\nSpecify number for addition to last number of blocks attributes : "))
     (repeat (setq i (sslength ss))
       (setq bl (ssname ss (setq i (1- i))))
       (foreach att (append (vlax-invoke (vlax-ename->vla-object bl) 'getattributes) (vlax-invoke (vlax-ename->vla-object bl) 'getconstantattributes))
         (if (not (vl-position att attlst))
           (progn
             (setq str (vla-get-textstring att))
             (if (and 
                   (/= str "")
                   (or 
                     (and (listp (f-MR "/" str)) (listp (f-MR "-" (car (f-MR "/" str)))) (numstrchk (last (f-MR "-" (car (f-MR "/" str))))))
                     (and (listp (f-MR "/" str)) (= (type (f-MR "-" (car (f-MR "/" str)))) 'str) (numstrchk (f-MR "-" (car (f-MR "/" str)))))
                     (and (= (type (f-MR "/" str)) 'str) (listp (f-MR "-" str)) (numstrchk (last (f-MR "-" str))))
                   )
                 ) 
               (progn
                 (setq splitstr (f-MR "/" str))
                 (if (listp splitstr)
                   (progn
                     (setq pref (car splitstr))
                     (setq pref (f-MR "-" pref))
                     (if (listp pref)
                       (progn
                         (setq lastnumber (last pref))
                         (setq lastnumber (itoa (+ (atoi lastnumber) n)))
                         (setq pref (reverse (cons lastnumber (cdr (reverse pref)))))
                         (setq newpref "")
                         (foreach s (reverse pref)
                           (setq newpref (strcat s "-" newpref))
                         )
                         (setq newpref (vl-string-right-trim "-" newpref))
                         (setq newstr (strcat newpref "/" (last splitstr)))
                       )
                       (progn
                         (setq lastnumber (itoa (+ (atoi pref) n)))
                         (setq newstr (strcat lastnumber "/" (last splitstr)))
                       )
                     )
                   )
                   (progn
                     (setq splitstr (f-MR "-" splitstr))
                     (if (listp splitstr)
                       (progn
                         (setq lastnumber (last splitstr))
                         (setq lastnumber (itoa (+ (atoi lastnumber) n)))
                         (setq splitstr (reverse (cons lastnumber (cdr (reverse splitstr)))))
                         (setq newstr "")
                         (foreach s (reverse splitstr)
                           (setq newstr (strcat s "-" newstr))
                         )
                         (setq newstr (vl-string-right-trim "-" newstr))
                       )
                     )
                   )
                 )
                 (vla-put-textstring att newstr)
                 (setq attlst (cons att attlst))
               )
             )
           )
         )
       )
     )
   )
 )
 (princ)
)