[编程交流] 按顺序编号并插入

;======================================================================
;    CopyInc2.lsp                  Last Revision: C.French 29/09/99
;----------------------------------------------------------------------
;  This routine allows you to copy a numerical text string multiple
;  times, incrementing the number by one each time. If the text has
;  an alphabetic prefix, this will be copied too. For example if you
;  copy the piece of text "A102", the next ones will be "A103", "A104"
;  and so on.
;
;  Many thanks to J. Richardson for the original "CopyInc" routine
;  upon which this one is based.
;======================================================================
(defun C:CopyInc ( / OrigEnt OrigEntData OrigText NumText
                    PrefixLen Prefix Num NewEntData NewPt Continue)
 (setq CopyIncOldErrorFunc *error*)
 (setq *error* CopyIncErrorFunc)
 (while (= OrigEnt nil)
   (setq OrigEnt (entsel "\nSelect text: "))
 )
 (setq OrigEntData (cdr (entget (car OrigEnt))))
 (if (/= (cdr (assoc 0 OrigEntData)) "TEXT")
   (princ "No text selected.")
   (progn
     (setq OrigText (cdr (assoc 1 OrigEntData)))
     (setq NumText (GetSuffixDigits OrigText))
     (if (= NumText "")
       (princ "That text string doesn't end with a number.")
       (progn
         (setq PrefixLen (- (strlen OrigText)(strlen NumText)))
         (if (= PrefixLen 0)
           (setq Prefix "")
           (setq Prefix (substr OrigText 1 PrefixLen))
         )
         (setq Num (atoi NumText))
         (setq Continue T)
         (while Continue
           (setq Num (1+ Num))
           (setq NewEntData (subst (cons 1 (strcat Prefix (itoa Num)))
                                   (assoc 1 OrigEntData) OrigEntData))
           (initget 128)
           (setq NewPt (getpoint "\nCopy to (press Enter to quit): "))
           (if (= NewPt nil)
             (setq Continue nil)
             (progn
               (setq NewEntData (subst (cons 10 NewPt)
                                       (assoc 10 NewEntData) NewEntData))
               (entmake NewEntData)
             )
           )
         );end of while loop
       )
     )
   )
 )
 (setq *error* CopyIncOldErrorFunc)
 (princ)
)
;----GetSuffixDigits---------------------------------------------------
;  This function accepts a string argument which has digits at the
;  end of it. It returns a string of just those digits. For example:
;    (GetSuffixDigits "A102")  returns  "102"
;    (GetSuffixDigits "102")   returns  "102"
;    (GetSuffixDigits "")      returns  ""
;    (GetSuffixDigits "ABC")   returns  ""
;    (GetSuffixDigits 123)  will generate an error (bad argument type)
;----------------------------------------------------------------------
(defun GetSuffixDigits ( OrigStr / Digits PrefixLen Char)
 (setq Digits "")
 (setq PrefixLen (strlen OrigStr))
 (while (> PrefixLen 0)
   (setq Char (substr OrigStr PrefixLen 1))   ;get last char of string
   (if (wcmatch Char "#")                     ;if it's a digit...
     (progn
       (setq Digits (strcat Char Digits))     ;include in result str
       (setq PrefixLen (1- PrefixLen))        ;ready to check next chr
     )
     (setq PrefixLen 0)                       ;quit at first alpha
   )
 )
 (setq Digits Digits)
)
;----Error Handling----------------------------------------------------
;  The routine below supplies our error handling in case the user
;  cancels the CopyInc function. The global holds the pointer to the
;  current error handler so it can be restored on exit.
;----------------------------------------------------------------------
(setq CopyIncOldErrorFunc nil)                 ;global holds old func
(defun CopyIncErrorFunc (msg)
 (if (= msg "Function cancelled")
   (princ " ")
   (if (= msg "quit / exit abort")
     (princ " ")
     (princ (strcat "\nError: " msg))
   )
 )
 (setq *error* CopyIncOldErrorFunc)
 (princ)
)
;----Instructions appear after loading on how to use-------------------
(princ "\nType 'CopyInc' to copy and increment a text string.")
(princ)

(defun c:ibl (/ atd blk cnt ech ipt next next_data osm pref suff tag)
 (setq osm (getvar "osmode"))
 (setq ech (getvar "cmdecho"))
 (setq atd (getvar "attdia"))
 (setvar "osmode" 0)
 (setvar "cmdecho" 0)
 (setvar "attdia" 1)
 (setq pref (getstring T "\nSpecify prefix or press Enter for none: "))
 (setq suff (getstring T "\nSpecify suffix or press Enter for none: "))
 (setq cnt (getint "\nEnter initial number: "))
 (if cnt
 (progn
 ;(setq tag (strcase (getstring "\nEnter attribute tag for numbering: ")))
 (setq tag "NUM");change attribute tag "NUM" on tag name in your block which uses for increment numbering
 
(while (setq ipt (getpoint "\nPick insertion point of block or press Enter to Exit: "))
(command "-insert" "STA" ipt 1 1 0);<- change block name "STA" on your block name here
(setq blk (entlast))
(setq next blk)
       (while (setq next (entnext next))
(setq next_data (entget next))
(if (= tag (cdr (assoc 2 next_data)))
  (progn
    (entmod (subst (cons 1 (strcat pref (itoa cnt) suff)) (assoc 1 next_data) next_data))
    (entupd blk)
  )
)
     )
            (setq cnt (1+ cnt))
            )
     )
   )
 (setvar "osmode" osm)
 (setvar "attdia" atd)
 (setvar "cmdecho" ech)
 (prin1)
 )
(prompt "\ntype iBL to execute ...")
(prin1)

(setq pref (getstring T "\nSpecify prefix or press Enter for none: "))

(setq pref "MyFavouritePrefix")