;;;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)
)

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