[编程交流] DCL位置

DDNUMB.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
   (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 (atoi (get_tile "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
   (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))
  (setq new (cons 1 (strcat prefix (rtos start_no 2 0) suffix)))
           (setq temp (subst new old temp))
           (entmod temp)
      (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))
  (setq new (cons 1 (strcat prefix (rtos start_no 2 0) suffix)))
           (setq temp (subst new old temp))
           (entmod temp)
      (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))
  (setq new (cons 1 (strcat prefix (rtos start_no 2 0) suffix)))
           (setq temp (subst new old temp))
           (entmod temp)
      (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))
  (setq new (cons 1 (strcat prefix (rtos start_no 2 0) suffix)))
           (setq temp (subst new old temp))
           (entmod temp)
      (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))
  (setq new (cons 1 (strcat prefix (rtos start_no 2 0) suffix)))
           (setq temp (subst new old temp))
           (entmod temp)
      (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))
  (setq new (cons 1 (strcat  prefix (cdr old) suffix)))
           (setq temp (subst new old temp))
           (entmod temp)
      (setq num (+ num 1))
      ) 
      )
    )
   )
  (if start_ok
   (get_txt)
 )
  (setq *error* olderr)
(setvar "cmdecho" cmd)
   )

//----------------------------------------------------------------------------
// 
// 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";
                        }
                }
        }

C:\\Users\\ian.anderson\\Desktop\\LISP LIBRARY\\autonumb.dcl

C:/Users/ian.anderson/Desktop/LISP LIBRARY/autonumb.dcl

(setq dcl_id1 (load_dialog "C:\\Users\\ian.anderson\\Desktop\\LISP LIBRARY\\autonumb.dcl"))