[转贴]：Autonumb

eachy · 发表于 2005-7-30 20:41:29

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;;CADALYST 03/05 Tip2018: autonumb.lsp Automatic Numbering (c) Scott Bestmeyer
;AUTONUMB.LSP for release 15
;Auto numbers text strings.
;Written by: S. Restmeyer 3/01
;;;
;;;----------------------ERROR FUNCTION----------------------------
;;;
(DEFUN ERR (S) ;if an error (such as CTRL-C)
;occurs while this command is active...
(if (not (member s '("console break" "Function cancelled")))
(princ (strcat "\nError: " s))
)
(command "_.UNDO" "_E") ;end any outstanding UNDO group
(setvar "cmdecho" cmd) ;restore saved mode
(setq *error* olderr)
(princ)
)
;;;---------------------- MAIN PROGRAM ----------------------------
;;;
(defun C:DDNUMB (/ CMD dcl_id1 olderr)
(setq olderr *error*
*error* err
)
(SETQ CMD (GETVAR "CMDECHO"))
(command "_.UNDO" "_G")
(setvar "cmdecho" 0)
(defun set_replace ()
(cond
((= (get_tile "do_replace") "0")
(set_tile "sort_type" "0")
(mode_tile "sort_type" 1)
(set_tile "start_no" " ")
(mode_tile "start_no" 1)
(set_tile "txt_inc" " ")
(mode_tile "txt_inc" 1)
)
)
(cond
((= (get_tile "do_replace") "1")
(mode_tile "sort_type" 0)
(mode_tile "start_no" 0)
(mode_tile "txt_inc" 0)
(if sort_type
(set_tile "sort_type" sort_type)
(set_tile "sort_type" "0")
)
(if txt_inc
(set_tile "txt_inc" (rtos txt_inc 2 0))
(set_tile "txt_inc" "1")
)
(if start_no
(progn
(if lead_0
(progn
(setq start_no
(strcat (substr lead_0
1
(- (strlen lead_0)
(strlen (rtos start_no 2 0))
)
)
(rtos start_no 2 0)
)
)
(set_tile "start_no" start_no)
)
(set_tile "start_no" (rtos start_no 2 0))
)
)
(set_tile "start_no" "1")
)
)
)
)
(defun my_help ()
(setq file_name (findfile "autonumb.pdf"))
(startapp "acrobat.exe" (strcat """ file_name """))
)
(defun get_data ()
(setq suffix (get_tile "suffix"))
(setq prefix (get_tile "prefix"))
(setq start_no (get_tile "start_no"))
(if (= (itoa (atoi start_no)) start_no)
(setq lead_0 nil)
(setq lead_0 start_no)
)
(setq start_no (atoi start_no))
(setq txt_inc (atoi (get_tile "txt_inc")))
(setq sort_type (get_tile "sort_type"))
(setq do_replace (get_tile "do_replace"))
)
;;;-------------------------------------------------------------------
;;;-----------THIS SECTION RETRIEVES USER INPUT INFORMATION------------
;;;
(setq dcl_id1 (load_dialog "autonumb.dcl"))
(if (not (new_dialog "ddstart" dcl_id1))
(exit)
)
(setq sort_list '("Selection" "Top-Bottom"
"Left-Right" "Bottom-Top"
"Right-Left"
)
)
(start_list "sort_type")
(mapcar 'add_list sort_list)
(end_list)
(if sort_type
(set_tile "sort_type" sort_type)
(set_tile "sort_type" "0")
)
(if prefix
(set_tile "prefix" prefix)
)
(if suffix
(set_tile "suffix" suffix)
)
(if start_no
(progn
(if lead_0
(progn
(setq
start_no (strcat (substr lead_0
1
(- (strlen lead_0)
(strlen (rtos start_no 2 0))
)
)
(rtos start_no 2 0)
)
)
(set_tile "start_no" start_no)
)
(set_tile "start_no" (rtos start_no 2 0))
)
)
(set_tile "start_no" "1")
)
(if txt_inc
(set_tile "txt_inc" (rtos txt_inc 2 0))
(set_tile "txt_inc" "1")
)
(action_tile "do_replace" "(set_replace)")
(action_tile "numb_hlp" "(my_help)")
(action_tile
"accept"
"(setq start_ok T)(get_data)(done_dialog 1)"
)
(action_tile "cancel" "(setq start_ok nil)(done_dialog 0)")
(start_dialog)
(unload_dialog dcl_id1)
;;;-------------------------------------------------------------------
;;;---------------THIS SECTION MODIFIES SELECTED TEXT-----------------
;;;
(defun get_txt (/ sset sset1 sset2 sset3 test num llen temp old)
(setq sset (ssget '((0 . "TEXT"))))
(setq num 0)
(if (= do_replace "1")
(progn
(cond
((= sort_type "0")
(while (< num (sslength sset))
(setq temp (entget (ssname sset num)))
(setq old (assoc 1 temp))
(if lead_0
(setq start_no
(strcat (substr lead_0
1
(- (strlen lead_0)
(strlen (rtos start_no 2 0))
)
)
(rtos start_no 2 0)
)
)
(setq start_no (rtos start_no 2 0))
)
(setq new (cons 1 (strcat prefix start_no suffix)))
(setq temp (subst new old temp))
(entmod temp)
(setq start_no (atoi start_no))
(setq start_no (+ start_no txt_inc))
(setq num (+ num 1))
)
)
((= sort_type "1")
(setq temp (caddr (assoc 10 (entget (ssname sset num)))))
(setq sset1 (list temp))
(setq num (+ num 1))
(while (< num (sslength sset))
(setq temp (caddr (assoc 10 (entget (ssname sset num)))))
(setq sset1 (append sset1 (list temp)))
(setq num (+ num 1))
)
(setq sset2 (list ""))
(while (< (- (length sset2) 1) (sslength sset))
(setq temp (apply 'max sset1))
(setq sset2 (append sset2 (list temp)))
(setq sset3 (list ""))
(setq num (- (length sset1) 1))
(while (> num -1)
(setq test (nth num sset1))
(if (not (member test sset2))
(setq sset3 (append sset3 (list test)))
)
(setq num (- num 1))
)
(setq sset1 (cdr sset3))
)
(setq sset2 (cdr sset2))
(setq llen 0)
(while (< llen (length sset2))
(setq test (nth llen sset2))
(setq num 0)
(while
(not
(= (caddr (assoc 10 (entget (ssname sset num)))) test)
)
(setq num (+ num 1))
)
(setq temp (entget (ssname sset num)))
(setq old (assoc 1 temp))
(if lead_0
(setq start_no
(strcat (substr lead_0
1
(- (strlen lead_0)
(strlen (rtos start_no 2 0))
)
)
(rtos start_no 2 0)
)
)
(setq start_no (rtos start_no 2 0))
)
(setq new (cons 1 (strcat prefix start_no suffix)))
(setq temp (subst new old temp))
(entmod temp)
(setq start_no (atoi start_no))
(setq start_no (+ start_no txt_inc))
(setq llen (+ llen 1))
)
)
((= sort_type "2")
(setq temp (cadr (assoc 10 (entget (ssname sset num)))))
(setq sset1 (list temp))
(setq num (+ num 1))
(while (< num (sslength sset))
(setq temp (cadr (assoc 10 (entget (ssname sset num)))))
(setq sset1 (append sset1 (list temp)))
(setq num (+ num 1))
)
(setq sset2 (list ""))
(while (< (- (length sset2) 1) (sslength sset))
(setq temp (apply 'max sset1))
(setq sset2 (append sset2 (list temp)))
(setq sset3 (list ""))
(setq num (- (length sset1) 1))
(while (> num -1)
(setq test (nth num sset1))
(if (not (member test sset2))
(setq sset3 (append sset3 (list test)))
)
(setq num (- num 1))
)
(setq sset1 (cdr sset3))
)
(setq sset2 (cdr sset2))
(setq llen (- (length sset2) 1))
(while (> llen -1)
(setq test (nth llen sset2))
(setq num 0)
(while
(not (= (cadr (assoc 10 (entget (ssname sset num)))) test)
)
(setq num (+ num 1))
)
(setq temp (entget (ssname sset num)))
(setq old (assoc 1 temp))
(if lead_0
(setq start_no
(strcat (substr lead_0
1
(- (strlen lead_0)
(strlen (rtos start_no 2 0))
)
)
(rtos start_no 2 0)
)
)
(setq start_no (rtos start_no 2 0))
)
(setq new (cons 1 (strcat prefix start_no suffix)))
(setq temp (subst new old temp))
(entmod temp)
(setq start_no (atoi start_no))
(setq start_no (+ start_no txt_inc))
(setq llen (- llen 1))
)
)
((= sort_type "3")
(setq temp (caddr (assoc 10 (entget (ssname sset num)))))
(setq sset1 (list temp))
(setq num (+ num 1))
(while (< num (sslength sset))
(setq temp (caddr (assoc 10 (entget (ssname sset num)))))
(setq sset1 (append sset1 (list temp)))
(setq num (+ num 1))
)
(setq sset2 (list ""))
(while (< (- (length sset2) 1) (sslength sset))
(setq temp (apply 'max sset1))
(setq sset2 (append sset2 (list temp)))
(setq sset3 (list ""))
(setq num (- (length sset1) 1))
(while (> num -1)
(setq test (nth num sset1))
(if (not (member test sset2))
(setq sset3 (append sset3 (list test)))
)
(setq num (- num 1))
)
(setq sset1 (cdr sset3))
)
(setq sset2 (cdr sset2))
(setq llen (- (length sset2) 1))
(while (> llen -1)
(setq test (nth llen sset2))
(setq num 0)
(while
(not
(= (caddr (assoc 10 (entget (ssname sset num)))) test)
)
(setq num (+ num 1))
)
(setq temp (entget (ssname sset num)))
(setq old (assoc 1 temp))
(if lead_0
(setq start_no
(strcat (substr lead_0
1
(- (strlen lead_0)
(strlen (rtos start_no 2 0))
)
)
(rtos start_no 2 0)
)
)
(setq start_no (rtos start_no 2 0))
)
(setq new (cons 1 (strcat prefix start_no suffix)))
(setq temp (subst new old temp))
(entmod temp)
(setq start_no (atoi start_no))
(setq start_no (+ start_no txt_inc))
(setq llen (- llen 1))
)
)
((= sort_type "4")
(setq temp (cadr (assoc 10 (entget (ssname sset num)))))
(setq sset1 (list temp))
(setq num (+ num 1))
(while (< num (sslength sset))
(setq temp (cadr (assoc 10 (entget (ssname sset num)))))
(setq sset1 (append sset1 (list temp)))
(setq num (+ num 1))
)
(setq sset2 (list ""))
(while (< (- (length sset2) 1) (sslength sset))
(setq temp (apply 'max sset1))
(setq sset2 (append sset2 (list temp)))
(setq sset3 (list ""))
(setq num (- (length sset1) 1))
(while (> num -1)
(setq test (nth num sset1))
(if (not (member test sset2))
(setq sset3 (append sset3 (list test)))
)
(setq num (- num 1))
)
(setq sset1 (cdr sset3))
)
(setq sset2 (cdr sset2))
(setq llen 0)
(while (< llen (length sset2))
(setq test (nth llen sset2))
(setq num 0)
(while
(not (= (cadr (assoc 10 (entget (ssname sset num)))) test)
)
(setq num (+ num 1))
)
(setq temp (entget (ssname sset num)))
(setq old (assoc 1 temp))
(if lead_0
(setq start_no
(strcat (substr lead_0
1
(- (strlen lead_0)
(strlen (rtos start_no 2 0))
)
)
(rtos start_no 2 0)
)
)
(setq start_no (rtos start_no 2 0))
)
(setq new (cons 1 (strcat prefix start_no suffix)))
(setq temp (subst new old temp))
(entmod temp)
(setq start_no (atoi start_no))
(setq start_no (+ start_no txt_inc))
(setq llen (+ llen 1))
)
)
)
)
(progn
(setq start_no nil)
(setq txt_inc nil)
(while (< num (sslength sset))
(setq temp (entget (ssname sset num)))
(setq old (assoc 1 temp))
(if lead_0
(setq
start_no (strcat (substr lead_0
1
(- (strlen lead_0)
(strlen (rtos start_no 2 0))
)
)
(rtos start_no 2 0)
)
)
(setq start_no (rtos start_no 2 0))
)
(setq new (cons 1 (strcat prefix start_no suffix)))
(setq temp (subst new old temp))
(entmod temp)
(setq start_no (atoi start_no))
(setq num (+ num 1))
)
)
)
)
(if start_ok
(get_txt)
)
(setq *error* olderr)
(setvar "cmdecho" cmd)
)

;;;CADALYST 03/05  Tip2018: autonumb.lsp   Automatic Numbering         (c) Scott Bestmeyer 
 
 
                                        ;AUTONUMB.LSP for release 15 
                                        ;Auto numbers text strings. 
                                        ;Written by: S. Restmeyer 3/01 
 
;;; 
;;;----------------------ERROR FUNCTION---------------------------- 
;;; 
(DEFUN ERR (S)                                ;if an error (such as CTRL-C) 
                                        ;occurs while this command is active... 
  (if (not (member s '("console break" "Function cancelled"))) 
    (princ (strcat "\nError: " s)) 
  ) 
  (command "_.UNDO" "_E")                ;end any outstanding UNDO group 
  (setvar "cmdecho" cmd)                ;restore saved mode 
  (setq *error* olderr) 
  (princ) 
) 
;;;---------------------- MAIN PROGRAM ---------------------------- 
;;; 
(defun C:DDNUMB        (/ CMD dcl_id1 olderr) 
  (setq        olderr        *error* 
        *error*        err 
  ) 
  (SETQ CMD (GETVAR "CMDECHO")) 
  (command "_.UNDO" "_G") 
  (setvar "cmdecho" 0) 
  (defun set_replace () 
    (cond 
      ((= (get_tile "do_replace") "0") 
       (set_tile "sort_type" "0") 
       (mode_tile "sort_type" 1) 
       (set_tile "start_no" " ") 
       (mode_tile "start_no" 1) 
       (set_tile "txt_inc" " ") 
       (mode_tile "txt_inc" 1) 
      ) 
    ) 
    (cond 
      ((= (get_tile "do_replace") "1") 
       (mode_tile "sort_type" 0) 
       (mode_tile "start_no" 0) 
       (mode_tile "txt_inc" 0) 
       (if sort_type 
         (set_tile "sort_type" sort_type) 
         (set_tile "sort_type" "0") 
       ) 
       (if txt_inc 
         (set_tile "txt_inc" (rtos txt_inc 2 0)) 
         (set_tile "txt_inc" "1") 
       ) 
       (if start_no 
         (progn 
           (if lead_0 
             (progn 
               (setq start_no 
                      (strcat (substr lead_0 
                                      1 
                                      (- (strlen lead_0) 
                                         (strlen (rtos start_no 2 0)) 
                                      ) 
                              ) 
                              (rtos start_no 2 0) 
                      ) 
               ) 
               (set_tile "start_no" start_no) 
             ) 
             (set_tile "start_no" (rtos start_no 2 0)) 
           ) 
         ) 
         (set_tile "start_no" "1") 
       ) 
      ) 
    ) 
  ) 
  (defun my_help () 
    (setq file_name (findfile "autonumb.pdf")) 
    (startapp "acrobat.exe" (strcat """ file_name """)) 
  ) 
  (defun get_data () 
    (setq suffix (get_tile "suffix")) 
    (setq prefix (get_tile "prefix")) 
    (setq start_no (get_tile "start_no")) 
    (if        (= (itoa (atoi start_no)) start_no) 
      (setq lead_0 nil) 
      (setq lead_0 start_no) 
    ) 
    (setq start_no (atoi start_no)) 
    (setq txt_inc (atoi (get_tile "txt_inc"))) 
    (setq sort_type (get_tile "sort_type")) 
    (setq do_replace (get_tile "do_replace")) 
  ) 
;;;------------------------------------------------------------------- 
;;;-----------THIS SECTION RETRIEVES USER INPUT INFORMATION------------ 
;;; 
  (setq dcl_id1 (load_dialog "autonumb.dcl")) 
  (if (not (new_dialog "ddstart" dcl_id1)) 
    (exit) 
  ) 
  (setq        sort_list '("Selection"              "Top-Bottom" 
                    "Left-Right"      "Bottom-Top" 
                    "Right-Left" 
                   ) 
  ) 
  (start_list "sort_type") 
  (mapcar 'add_list sort_list) 
  (end_list) 
  (if sort_type 
    (set_tile "sort_type" sort_type) 
    (set_tile "sort_type" "0") 
  ) 
  (if prefix 
    (set_tile "prefix" prefix) 
  ) 
  (if suffix 
    (set_tile "suffix" suffix) 
  ) 
  (if start_no 
    (progn 
      (if lead_0 
        (progn 
          (setq 
            start_no (strcat (substr lead_0 
                                     1 
                                     (-        (strlen lead_0) 
                                        (strlen (rtos start_no 2 0)) 
                                     ) 
                             ) 
                             (rtos start_no 2 0) 
                     ) 
          ) 
          (set_tile "start_no" start_no) 
        ) 
        (set_tile "start_no" (rtos start_no 2 0)) 
      ) 
    ) 
    (set_tile "start_no" "1") 
  ) 
  (if txt_inc 
    (set_tile "txt_inc" (rtos txt_inc 2 0)) 
    (set_tile "txt_inc" "1") 
  ) 
  (action_tile "do_replace" "(set_replace)") 
  (action_tile "numb_hlp" "(my_help)") 
  (action_tile 
    "accept" 
    "(setq start_ok T)(get_data)(done_dialog 1)" 
  ) 
  (action_tile "cancel" "(setq start_ok nil)(done_dialog 0)") 
  (start_dialog) 
  (unload_dialog dcl_id1) 
;;;------------------------------------------------------------------- 
;;;---------------THIS SECTION MODIFIES SELECTED TEXT----------------- 
;;; 
  (defun get_txt (/ sset sset1 sset2 sset3 test num llen temp old) 
    (setq sset (ssget '((0 . "TEXT")))) 
    (setq num 0) 
    (if        (= do_replace "1") 
      (progn 
        (cond 
          ((= sort_type "0") 
           (while (< num (sslength sset)) 
             (setq temp (entget (ssname sset num))) 
             (setq old (assoc 1 temp)) 
             (if lead_0 
               (setq start_no 
                      (strcat (substr lead_0 
                                      1 
                                      (- (strlen lead_0) 
                                         (strlen (rtos start_no 2 0)) 
                                      ) 
                              ) 
                              (rtos start_no 2 0) 
                      ) 
               ) 
               (setq start_no (rtos start_no 2 0)) 
             ) 
             (setq new (cons 1 (strcat prefix start_no suffix))) 
             (setq temp (subst new old temp)) 
             (entmod temp) 
             (setq start_no (atoi start_no)) 
             (setq start_no (+ start_no txt_inc)) 
             (setq num (+ num 1)) 
           ) 
          ) 
          ((= sort_type "1") 
           (setq temp (caddr (assoc 10 (entget (ssname sset num))))) 
           (setq sset1 (list temp)) 
           (setq num (+ num 1)) 
           (while (< num (sslength sset)) 
             (setq temp (caddr (assoc 10 (entget (ssname sset num))))) 
             (setq sset1 (append sset1 (list temp))) 
             (setq num (+ num 1)) 
           ) 
           (setq sset2 (list "")) 
           (while (< (- (length sset2) 1) (sslength sset)) 
             (setq temp (apply 'max sset1)) 
             (setq sset2 (append sset2 (list temp))) 
             (setq sset3 (list "")) 
             (setq num (- (length sset1) 1)) 
             (while (> num -1) 
               (setq test (nth num sset1)) 
               (if (not (member test sset2)) 
                 (setq sset3 (append sset3 (list test))) 
               ) 
               (setq num (- num 1)) 
             ) 
             (setq sset1 (cdr sset3)) 
           ) 
           (setq sset2 (cdr sset2)) 
           (setq llen 0) 
           (while (< llen (length sset2)) 
             (setq test (nth llen sset2)) 
             (setq num 0) 
             (while 
               (not 
                 (= (caddr (assoc 10 (entget (ssname sset num)))) test) 
               ) 
                (setq num (+ num 1)) 
             ) 
             (setq temp (entget (ssname sset num))) 
             (setq old (assoc 1 temp)) 
             (if lead_0 
               (setq start_no 
                      (strcat (substr lead_0 
                                      1 
                                      (- (strlen lead_0) 
                                         (strlen (rtos start_no 2 0)) 
                                      ) 
                              ) 
                              (rtos start_no 2 0) 
                      ) 
               ) 
               (setq start_no (rtos start_no 2 0)) 
             ) 
             (setq new (cons 1 (strcat prefix start_no suffix))) 
             (setq temp (subst new old temp)) 
             (entmod temp) 
             (setq start_no (atoi start_no)) 
             (setq start_no (+ start_no txt_inc)) 
             (setq llen (+ llen 1)) 
           ) 
          ) 
          ((= sort_type "2") 
           (setq temp (cadr (assoc 10 (entget (ssname sset num))))) 
           (setq sset1 (list temp)) 
           (setq num (+ num 1)) 
           (while (< num (sslength sset)) 
             (setq temp (cadr (assoc 10 (entget (ssname sset num))))) 
             (setq sset1 (append sset1 (list temp))) 
             (setq num (+ num 1)) 
           ) 
           (setq sset2 (list "")) 
           (while (< (- (length sset2) 1) (sslength sset)) 
             (setq temp (apply 'max sset1)) 
             (setq sset2 (append sset2 (list temp))) 
             (setq sset3 (list "")) 
             (setq num (- (length sset1) 1)) 
             (while (> num -1) 
               (setq test (nth num sset1)) 
               (if (not (member test sset2)) 
                 (setq sset3 (append sset3 (list test))) 
               ) 
               (setq num (- num 1)) 
             ) 
             (setq sset1 (cdr sset3)) 
           ) 
           (setq sset2 (cdr sset2)) 
           (setq llen (- (length sset2) 1)) 
           (while (> llen -1) 
             (setq test (nth llen sset2)) 
             (setq num 0) 
             (while 
               (not (= (cadr (assoc 10 (entget (ssname sset num)))) test) 
               ) 
                (setq num (+ num 1)) 
             ) 
             (setq temp (entget (ssname sset num))) 
             (setq old (assoc 1 temp)) 
             (if lead_0 
               (setq start_no 
                      (strcat (substr lead_0 
                                      1 
                                      (- (strlen lead_0) 
                                         (strlen (rtos start_no 2 0)) 
                                      ) 
                              ) 
                              (rtos start_no 2 0) 
                      ) 
               ) 
               (setq start_no (rtos start_no 2 0)) 
             ) 
             (setq new (cons 1 (strcat prefix start_no suffix))) 
             (setq temp (subst new old temp)) 
             (entmod temp) 
             (setq start_no (atoi start_no)) 
             (setq start_no (+ start_no txt_inc)) 
             (setq llen (- llen 1)) 
           ) 
          ) 
          ((= sort_type "3") 
           (setq temp (caddr (assoc 10 (entget (ssname sset num))))) 
           (setq sset1 (list temp)) 
           (setq num (+ num 1)) 
           (while (< num (sslength sset)) 
             (setq temp (caddr (assoc 10 (entget (ssname sset num))))) 
             (setq sset1 (append sset1 (list temp))) 
             (setq num (+ num 1)) 
           ) 
           (setq sset2 (list "")) 
           (while (< (- (length sset2) 1) (sslength sset)) 
             (setq temp (apply 'max sset1)) 
             (setq sset2 (append sset2 (list temp))) 
             (setq sset3 (list "")) 
             (setq num (- (length sset1) 1)) 
             (while (> num -1) 
               (setq test (nth num sset1)) 
               (if (not (member test sset2)) 
                 (setq sset3 (append sset3 (list test))) 
               ) 
               (setq num (- num 1)) 
             ) 
             (setq sset1 (cdr sset3)) 
           ) 
           (setq sset2 (cdr sset2)) 
           (setq llen (- (length sset2) 1)) 
           (while (> llen -1) 
             (setq test (nth llen sset2)) 
             (setq num 0) 
             (while 
               (not 
                 (= (caddr (assoc 10 (entget (ssname sset num)))) test) 
               ) 
                (setq num (+ num 1)) 
             ) 
             (setq temp (entget (ssname sset num))) 
             (setq old (assoc 1 temp)) 
             (if lead_0 
               (setq start_no 
                      (strcat (substr lead_0 
                                      1 
                                      (- (strlen lead_0) 
                                         (strlen (rtos start_no 2 0)) 
                                      ) 
                              ) 
                              (rtos start_no 2 0) 
                      ) 
               ) 
               (setq start_no (rtos start_no 2 0)) 
             ) 
             (setq new (cons 1 (strcat prefix start_no suffix))) 
             (setq temp (subst new old temp)) 
             (entmod temp) 
             (setq start_no (atoi start_no)) 
             (setq start_no (+ start_no txt_inc)) 
             (setq llen (- llen 1)) 
           ) 
          ) 
          ((= sort_type "4") 
           (setq temp (cadr (assoc 10 (entget (ssname sset num))))) 
           (setq sset1 (list temp)) 
           (setq num (+ num 1)) 
           (while (< num (sslength sset)) 
             (setq temp (cadr (assoc 10 (entget (ssname sset num))))) 
             (setq sset1 (append sset1 (list temp))) 
             (setq num (+ num 1)) 
           ) 
           (setq sset2 (list "")) 
           (while (< (- (length sset2) 1) (sslength sset)) 
             (setq temp (apply 'max sset1)) 
             (setq sset2 (append sset2 (list temp))) 
             (setq sset3 (list "")) 
             (setq num (- (length sset1) 1)) 
             (while (> num -1) 
               (setq test (nth num sset1)) 
               (if (not (member test sset2)) 
                 (setq sset3 (append sset3 (list test))) 
               ) 
               (setq num (- num 1)) 
             ) 
             (setq sset1 (cdr sset3)) 
           ) 
           (setq sset2 (cdr sset2)) 
           (setq llen 0) 
           (while (< llen (length sset2)) 
             (setq test (nth llen sset2)) 
             (setq num 0) 
             (while 
               (not (= (cadr (assoc 10 (entget (ssname sset num)))) test) 
               ) 
                (setq num (+ num 1)) 
             ) 
             (setq temp (entget (ssname sset num))) 
             (setq old (assoc 1 temp)) 
             (if lead_0 
               (setq start_no 
                      (strcat (substr lead_0 
                                      1 
                                      (- (strlen lead_0) 
                                         (strlen (rtos start_no 2 0)) 
                                      ) 
                              ) 
                              (rtos start_no 2 0) 
                      ) 
               ) 
               (setq start_no (rtos start_no 2 0)) 
             ) 
             (setq new (cons 1 (strcat prefix start_no suffix))) 
             (setq temp (subst new old temp)) 
             (entmod temp) 
             (setq start_no (atoi start_no)) 
             (setq start_no (+ start_no txt_inc)) 
             (setq llen (+ llen 1)) 
           ) 
          ) 
        ) 
      ) 
      (progn 
        (setq start_no nil) 
        (setq txt_inc nil) 
        (while (< num (sslength sset)) 
          (setq temp (entget (ssname sset num))) 
          (setq old (assoc 1 temp)) 
          (if lead_0 
            (setq 
              start_no (strcat (substr lead_0 
                                       1 
                                       (- (strlen lead_0) 
                                          (strlen (rtos start_no 2 0)) 
                                       ) 
                               ) 
                               (rtos start_no 2 0) 
                       ) 
            ) 
            (setq start_no (rtos start_no 2 0)) 
          ) 
          (setq new (cons 1 (strcat prefix start_no suffix))) 
          (setq temp (subst new old temp)) 
          (entmod temp) 
          (setq start_no (atoi start_no)) 
          (setq num (+ num 1)) 
        ) 
      ) 
    ) 
  ) 
  (if start_ok 
    (get_txt) 
  ) 
  (setq *error* olderr) 
  (setvar "cmdecho" cmd) 
)

DCL

//----------------------------------------------------------------------------
//
// Corresponding dialogue for DDNUMB.LSP
//
//----------------------------------------------------------------------------
//dcl_settings : default_dcl_settings { audit_level = 3; }
ddstart : dialog {
label = "Auto Number";
initial_focus = "prefix";
: row {
: boxed_column {
fixed_width = true;
label = "&Prefix";
: edit_box {
key = "prefix";
mnemonic = "P";
fixed_width = true;
}
}
: boxed_column {
fixed_width = true;
label = "Start &No";
: edit_box {
key = "start_no";
mnemonic = "N";
fixed_width = true;
}
}
: boxed_column {
fixed_width = true;
label = "&Suffix";
: edit_box {
key = "suffix";
mnemonic = "S";
fixed_width = true;
}
}
}
: row {
: boxed_column {
fixed_width = true;
label = "&Increment";
: edit_box {
key = "txt_inc";
mnemonic = "I";
fixed_width = true;
}
}
: boxed_column {
fixed_width = true;
label = "Sort &By";
: popup_list {
key = "sort_type";
width = 13;
fixed_width = true;
}
}
: toggle {
label = "Replace";
key = "do_replace";
value = 1;
}
}
spacer_1;
: row {
ok_cancel;
: button {
key = "numb_hlp";
label = "Help";
mnemonic = "H";
}
}
}

//---------------------------------------------------------------------------- 
// 
// Corresponding dialogue for DDNUMB.LSP 
// 
//---------------------------------------------------------------------------- 
 
//dcl_settings : default_dcl_settings { audit_level = 3; } 
 
 
ddstart : dialog { 
     label = "Auto Number"; 
        initial_focus = "prefix"; 
                : row { 
                : boxed_column { 
                        fixed_width = true; 
                        label = "&Prefix"; 
                                : edit_box { 
                                        key = "prefix"; 
                                        mnemonic = "P"; 
                                        fixed_width = true; 
                                           } 
                                } 
                : boxed_column { 
                        fixed_width = true; 
                        label = "Start &No"; 
                                : edit_box { 
                                        key = "start_no"; 
                                        mnemonic = "N"; 
                                        fixed_width = true; 
                                           } 
                                } 
                : boxed_column { 
                        fixed_width = true; 
                        label = "&Suffix"; 
                                : edit_box { 
                                        key = "suffix"; 
                                        mnemonic = "S"; 
                                        fixed_width = true; 
                                           } 
                                } 
                        } 
        : row { 
                : boxed_column { 
                        fixed_width = true; 
                        label = "&Increment"; 
                                : edit_box { 
                                        key = "txt_inc"; 
                                        mnemonic = "I"; 
                                        fixed_width = true; 
                                           } 
                                } 
                : boxed_column { 
                        fixed_width = true; 
                        label = "Sort &By"; 
                                : popup_list { 
                                        key = "sort_type"; 
                                        width = 13; 
                                        fixed_width = true; 
                                        } 
                                } 
                : toggle { 
                        label = "Replace"; 
                        key = "do_replace"; 
                        value = 1; 
                        } 
                } 
                spacer_1; 
                : row { 
        ok_cancel; 
                        : button { 
                                key = "numb_hlp"; 
                                label = "Help"; 
                                mnemonic = "H"; 
                                } 
                        } 
                }

eachy · 发表于 2005-7-30 20:46:17

eachy · 发表于 2005-7-30 21:49:26

最初由 chdxllll 发布
[B]有些什么功能，主要可以用在那方面？介绍一下 [/B]

学会自己看，我也是看到后觉得有用就贴上来，你可以搜索以前的关于自动编号相关帖子。
说明以上程序未经测试，只是转贴。

贱人 · 发表于 2005-8-15 21:24:29

很好用啊，不过那个replace选项什么意思？不选就出错

eachy · 发表于 2005-8-16 10:14:27

最初由贱人发布
[B]很好用啊，不过那个replace选项什么意思？不选就出错 [/B]

程序中有错误，看了下程序，应该是 ET 中自动编号的DCL版本，Replace 取消作者的意思可能是加前后缀，这个就和ET中的不同了。按这个意思我编译了个文件，DCL已汉化。

账号		自动登录	找回密码
密码			立即注册