;布局增减及重排序[LM_TabSort].lsp
;;--------------------=={ TabSort.lsp }==---------------------;;
;;                                                            ;;
;;  A program designed with the intention to aid in the       ;;
;;  organisation of layout tabs in a drawing.                 ;;
;;                                                            ;;
;;  The program enables the user to organise each layout tab  ;;
;;  using buttons to move the tabs up, down, to the top, and  ;;
;;  to the bottom of a list.                                  ;;
;;                                                            ;;
;;  The user may rename any layout by double clicking on it,  ;;
;;  and can also add a Prefix and/or Suffix to selected/every ;;
;;  layout tab.                                               ;;
;;                                                            ;;
;;  The program offers the facility to add and delete a       ;;
;;  layout tab, and also sort the tabs alphabetically,        ;;
;;  numerically, architecturally; or reverse the order in     ;;
;;  which they appear.                                        ;;
;;                                                            ;;
;;  A Find and Replace function is incorporated to allow the  ;;
;;  user to quickly replace a text string in multiple tabs.   ;;
;;                                                            ;;
;;  The user can also Copy a layout tab, and set the Selected ;;
;;  layout tab as the current tab.                            ;;
;;                                                            ;;
;;  The Help Dialog can be access by pressing "H" at the Main ;;
;;  Dialog.                                                   ;;
;;                                                            ;;
;;------------------------------------------------------------;;
;;                                                            ;;
;;  FUNCTION SYNTAX:  TABSORT                                 ;;
;;                                                            ;;
;;  Notes:-                                                   ;;
;;  The Reset button will reset Tab Order and Tab Names, but  ;;
;;  will not affect newly created tabs and will not recreate  ;;
;;  deleted tabs.                                             ;;
;;                                                            ;;
;;  In the case that multiple tabs are selected, the Current  ;;
;;  button will set the tab with the lowest index (highest in ;;
;;  the list) as the current tab.                             ;;
;;                                                            ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;                                                            ;;
;;  With Thanks To:                                           ;;
;;  --------------------                                      ;;
;;  Gilles Chanteau (Gile)                                    ;;
;;                                                            ;;
;;  For his fantastic contribution to the list manipulation   ;;
;;  required for multiple DCL selections, and effort towards  ;;
;;  the Architectural Sort functions.                         ;;
;;                                                            ;;
;;------------------------------------------------------------;;
;;  Charles Alan Butler (CAB)                                 ;;
;;                                                            ;;
;;  For his excellent idea to incorporate the Help button for ;;
;;  those who need it.                                        ;;
;;                                                            ;;
;;------------------------------------------------------------;;
;;  Version:                                                  ;;
;;                                                            ;;
;;  1.0    -  13th September 2009                             ;;
;;                                                            ;;
;;  First Release                                             ;;
;;------------------------------------------------------------;;
;;  1.1    -  14th September 2009                             ;;
;;                                                            ;;
;;  Added Mnemonics to Tiles                                  ;;
;;  Added text to notify of double-click availability         ;;
;;  Added option to only pref/suff selected tab               ;;
;;------------------------------------------------------------;;
;;  1.2    -  15th September 2009                             ;;
;;                                                            ;;
;;  Added Numerical Sort                                      ;;
;;  General Bug Fixes                                         ;;
;;------------------------------------------------------------;;
;;  1.3    -  15th September 2009                             ;;
;;                                                            ;;
;;  Multi-tab Selection Functionality                         ;;
;;------------------------------------------------------------;;
;;  1.4    -  16th September 2009                             ;;
;;                                                            ;;
;;  Added Button to Set Current Tab                           ;;
;;  Added Copy Tab Functionality                              ;;
;;------------------------------------------------------------;;
;;  1.5    -  17th September 2009                             ;;
;;                                                            ;;
;;  Fixed Bug to Copy Layout Plot Settings                    ;;
;;------------------------------------------------------------;;
;;  1.6    -  18th September 2009                             ;;
;;                                                            ;;
;;  Modified Action_Tile Stmts ~ Thanks VovKa                 ;;
;;  Added Architectural Sort Button                           ;;
;;------------------------------------------------------------;;
;;  1.6.1  -  19th September 2009                             ;;
;;                                                            ;;
;;  Fixed Bugs ~ Thanks for feedback CAB                      ;;
;;------------------------------------------------------------;;
;;  1.7    -  20th September 2009                             ;;
;;                                                            ;;
;;  Added Find & Replace Functionality                        ;;
;;  Organised buttons/Added Sort Dialog                       ;;
;;------------------------------------------------------------;;
;;  1.7.1  -  20th September 2009                             ;;
;;                                                            ;;
;;  Replaced StrBrk sub with SplitStr (Gile)                  ;;
;;------------------------------------------------------------;;
;;  1.8    -  21st September 2009                             ;;
;;                                                            ;;
;;  Added hidden Help Button (CAB)                            ;;
;;  Added Help Dialog Definition                              ;;
;;------------------------------------------------------------;;
;;  1.8.1  -  22nd September 2009                             ;;
;;                                                            ;;
;;  General Bug Fixes                                         ;;
;;------------------------------------------------------------;;
;;  1.8.2  -  23rd September 2009                             ;;
;;                                                            ;;
;;  Fixed Bug causing crash when Deleting all                 ;;
;;  Tabs ~ thanks VovKa                                       ;;
;;------------------------------------------------------------;;
;;  1.9    -     2nd October 2009                             ;;
;;                                                            ;;
;;  Modified Reverse function to only apply to selected Tabs. ;;
;;  Altered Help Dialog to ok_only button                     ;;
;;------------------------------------------------------------;;
;;  2.0    -       22nd July 2010                             ;;
;;                                                            ;;
;;  Fixed Bug with Find/Replace.                              ;;
;;------------------------------------------------------------;;
;;  2.1    -    9th December 2010                             ;;
;;                                                            ;;
;;  Fixed Bug with Double Reversal                            ;;
;;------------------------------------------------------------;;
;;  2.2    -        16th May 2011                             ;;
;;                                                            ;;
;;  Program completely rewritten to update formatting.        ;;
;;  Upgraded Find & Replace engine to allow for               ;;
;;  self-referencing find and replace terms and improved      ;;
;;  visual feedback.                                          ;;
;;  Updated list manipulation subfunctions.                   ;;
;;------------------------------------------------------------;;

(defun c:lm_TabSort ( /

			;; --={  Local Functions  }=--

			old_cmd
			_addtab
			_archsort
			_copytab
			_deletetabs
			_findreplacetab
			_getlayouts
			_list->value
			_numsort
			_removeitems
			_renametab
			_tabprefixsuffix
			_tabsort
			_tabsorthelp
			_value->list
			_writedcl

			;; --={  Local Variables  }=--

			acdoc
			aclay
			aclays
			dclst
			found
			fstr
			i
			idx
			l
			lst
			nam
			pref
			ptr
			reslst
			rstr
			suff
			x
			refleshtabs
			old_dcl_load
			old
			tmp
			newres
			j
			lay
			txt_n txt_a txt_sty num_styles
			;*error* _StartUndo _EndUndo

			;; --={  Global Variables  }=--

			;  *prefdef*  -  Setting to Apply a Prefix/Suffix to All Tabs
			;  *SortTyp*  -  Sort Type Settings
			;  *SortOrd*  -  Sort Order Settings

	)

;;------------------------------------------------------------;;
;;                       Local Functions                      ;;
;;------------------------------------------------------------;;


;;------------------------------------------------------------;;
; (progn
  ; (defun *error* ( msg )
    ; (if acdoc (_EndUndo acdoc))
    ; (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        ; (princ (strcat "\n** Error: " msg " **")))
    ; (princ)
  ; )

;------------------------------------------------------------;;

  ; (defun _StartUndo ( doc ) (_EndUndo doc)
    ; (vla-StartUndoMark doc)
  ; )

  ; (defun _EndUndo ( doc )
    ; (if (= 8 (logand 8 (getvar 'UNDOCTL)))
      ; (vla-EndUndoMark doc)
    ; )
  ; )
(defun _value->list ( val ) (read (strcat "(" val ")")))

(defun _list->value ( lst ) (vl-string-trim "()" (vl-princ-to-string lst)))

;;------------------------------------------------------------;;

(defun _GetLayouts ( layouts / lst la)
	(vlax-for la layouts
		(or (eq "MODEL" (strcase (vlax-get la 'Name)))
			(setq lst (cons (list (vlax-get la 'taborder) la) lst))
		)
	)
	(mapcar 'cadr (vl-sort lst '(lambda ( a b ) (< (car a) (car b)))))
)


;;------------------------------------------------------------;;

(defun _WriteDCL ( )
	(mai_load_dialog
		'(
			"dcl_settings : default_dcl_settings { audit_level = 1; }"
			"//                   SubAssembly Definitions                  //"
			""
			"button13 : button   { width = 13; alignment = centered; fixed_width = false; }"
			"button16 : button   { width = 16; alignment = centered; fixed_width = false; }"
			"    eBox : edit_box { alignment = centered; fixed_width = false; allow_accept = true; is_tab_stop = true; }"
			"    fBox : edit_box { alignment = left; fixed_width = true; is_tab_stop = true; }"
			"   title : text     { alignment = centered; is_bold = true; fixed_width = false;}"
			"     txt : text     { alignment = centered; fixed_width = false; }"
			"    ltxt : text     { alignment = left;     fixed_width = false; }"
			""
			"//------------------------------------------------------------//"
			"//                        Main Dialog                         //"
			"//------------------------------------------------------------//"
			""
			"tabsort : dialog { key = \"dcltitle\";"
			"  : column {"
			"  : row {"
			"  : column {"
			"  : boxed_row {"
			"    : button13 { key = \"mtop\"; label = \"置顶 &T\"; }"
			"    : button13 { key = \"up\"  ; label = \"上移 &U\"; }"
			"    : button13 { key = \"down\"; label = \"下移 &D\"; }"
			"    : button13 { key = \"mbot\"; label = \"沉底 &B\"; }"
			"        }"
			"  : row {"
			"      : text { label = \"双击重命名条目\";}"
			"      : image_button { key = \"help\"; label = \"&help\"; color = -15; height = 0.1; width = 0.1; fixed_width = true; }"
			"  }"
			"  : list_box { key = \"tabs\"; height=20;width = 20; fixed_width = false; alignment = centered;  multiple_select = true; }"
			"  }"
			"  "
			"  : boxed_column {"
			"    : button13 { key = \"sort\"; label = \"排序方法 &S\"; }"
			"    : button13 { key = \"rev\" ; label = \"前后反转 &R\"; }"
			"    : button13 { key = \"p_s\" ; label = \"批量改名 &P\"; }"
			"    : button13 { key = \"cur\" ; label = \"当    前 &N\"; }"
			"    : button13 { key = \"add\"   ; label = \"增    加 &A\"; }"
			"    : button13 { key = \"del\"   ; label = \"删    除 &E\"; }"
			"    : button13 { key = \"copy\"  ; label = \"复    制 &Y\"; }"
			"    : button13 { key = \"fnr\"   ; label = \"搜    索 &F\"; }"
			"  }"
			"  }"
			"  :  boxed_row {"
			"    : button13 { key = \"accept\"; label = \"确定 &O\"; is_default = true;}"
			"    : button13 { key = \"res\"   ; label = \"重置 &S\"; } "
			"    : button13 { key = \"cancel\"; label = \"取消 &C\"; is_cancel  = true; }"
			"  }"
			"  }"
			"}"
			""
			"//------------------------------------------------------------//"
			"//                        Rename Dialog                       //"
			"//------------------------------------------------------------//"
			""
			"rename : dialog { label = \"改名\"; spacer;"
			"  : eBox { key = \"name\"; edit_width = 20; edit_limit = 255; label = \"名称:\"; }"
			"  : errtile { } "
			"  spacer; ok_cancel;"
			"}"
			""
			"//------------------------------------------------------------//"
			"//                    Delete Warning Dialog                   //"
			"//------------------------------------------------------------//"
			""
			"delwarn : dialog { label = \"警告：\"; spacer;"
			"  : text { alignment = centered; label = \"选择的会被永久删除\"; }"
			"  : text { alignment = centered; label = \"删除？\"; }"
			"  spacer; ok_cancel;"
			"}"
			""
			"//------------------------------------------------------------//"
			"//                    Prefix/Suffix Dialog                    //"
			"//------------------------------------------------------------//"
			""
			"prefsuff : dialog { label = \"批量改名\"; spacer;"
			""
			"  : row {"
			"    : column {"
			"      : text { alignment = centered; label = \"前缀\"; }"
			"      : eBox { key = \"pref\"; edit_width = 15; edit_limit = 255; }"
			"    }"
			"    : column {"
			"      : text { alignment = centered; label = \"起始序号\"; }"
			"      : eBox { key = \"txt_n\"; edit_width = 15; edit_limit = 255; }"
			"    }"
			; "    : column {"
			; "      : spacer { alignment = centered; width = 10; }"
			; "      : text   { alignment = centered; label = \"< 名称 >\"; }"
			; "    }"
			"    : column {"
			"      : text { alignment = centered; label = \"后缀\"; }"
			"      : eBox { key = \"suff\"; edit_width = 15; edit_limit = 255; }"
			"    }"
			"  }  "
			":edit_box{label=\"序号增量:\";key=\"txt_a\";}"
			":popup_list{label=\"序号形式:\";key=\"txt_sty\";}"
			":text{key=\"preview\";}"
			"  spacer;"
			"  "
			"  : row { spacer;"
			"    : toggle { key = \"all\"; label = \"应用到所有 &A\"; alignment = right; is_tab_stop = true; }"
			"  }"
			"  : errtile { } ok_cancel;"
			"}"
			""
			"//------------------------------------------------------------//"
			"//                        Find Dialog                         //"
			"//------------------------------------------------------------//"
			""
			"find : dialog { label = \"搜索替换\"; spacer;"
			""
			"  : row {"
			"    : column { fixed_height = true;"
			"      : text { key = \"fw\"  ; label = \"查找啥 &W:\" ; }"
			"      : fBox { key = \"fstr\"; edit_width = 30;}"
			"      : text { key = \"rw\"  ; label = \"替换成 &R:\"        ; }"
			"      : fBox { key = \"rstr\"; edit_width = 30; }"
			"    }"
			"    : spacer { width = 4; }"
			"    : column { fixed_height = true;"
			"      : spacer   { height = 0.2   ; }"
			"      : button16 { key = \"fnd\"  ; label = \"查找 &F\"; }"
			"      : button16 { key = \"rep\"  ; label = \"替换 &P\"; }"
			"      : button16 { key = \"repa\" ; label = \"替换所有 &A\"; }"
			"    }"
			"  }"
			"  "
			"  spacer;"
			"  : text { key = \"ftxt\"; alignment = left; label = \"没有符合的名称被搜索到!\"; value = \"\"; }"
			"  spacer;"
			"  : button13 { key = \"accept\";    label = \"确定 &O\"; is_default = true; is_cancel = true  ; }"
			"}"
			""
			"//------------------------------------------------------------//"
			"//                        Sort Dialog                         //"
			"//------------------------------------------------------------//"
			""
			"sort : dialog { label = \"排序\"; spacer;"
			"  : boxed_column { label = \"排序方法\";"
			"    : popup_list { key = \"typ\"; alignment = centered; }"
			"    spacer;"
			"    : radio_row { children_alignment = centered;"
			"      : radio_button { key = \"asc\"; label = \"由小到大\" ; }"
			"      : radio_button { key = \"des\"; label = \"由大到小\"; }"
			"    }"
			"    spacer;"
			"  }"
			"  spacer;"
			"  : row { fixed_width = false; alignment = centered;"
			"    : button13 { key = \"accept\"; label = \"确定 &S\"  ; is_default = true; }"
			"    : button13 { key = \"cancel\"; label = \"取消 &C\";  is_cancel  = true; }"
			"  }"
			"}"
			""
			"//------------------------------------------------------------//"
			"//                        Help Dialog                         //"
			"//------------------------------------------------------------//"
			""
			"help : dialog { key = \"htitle\";"
			"  spacer; : title { label = \"  ------------------------------------------  \" ; }"
			"  spacer; : title { label = \"  ------------------------------------------  \" ; }"
			"  spacer; : ltxt  { label = \"   程序控制:\" ; }"
			"  spacer;"
			"  : row { fixed_width = true; alignment = centered;"
			"    : column {"
			"       : txt { label = \"[\"     ; }"
			"       : txt { label = \"[\"     ; }"
			"       : txt { label = \"[\"     ; }"
			"       : txt { label = \"[\"     ; }"
			"       : txt { label = \"[\"     ; }"
			"       : txt { label = \"-->\"   ; }"
			"       : txt { label = \"-->\"   ; }"
			"       : txt { label = \"-->\"   ; }"
			"       : txt { label = \"[\"     ; }"
			"       : txt { label = \"[\"     ; }"
			"       : txt { label = \"[\"     ; }"
			"       : txt { label = \"[\"     ; }"
			"       : txt { label = \"[\"     ; }"
			"       : txt { label = \"[\"     ; }"
			"       : txt { label = \"[\"     ; }"
			"       : txt { label = \"[\"     ; }"
			"       : txt { label = \"[\"     ; }"
			"    }"
			"    : column {"
			"       : txt { label = \"Top\"          ; }"
			"       : txt { label = \"Up\"           ; }"
			"       : txt { label = \"Down\"         ; }"
			"       : txt { label = \"Bottom\"       ; }"
			"       : txt { label = \"Sort\"         ; }"
			"       : txt { label = \"Alphabetical\" ; }"
			"       : txt { label = \"Numerical\"    ; }"
			"       : txt { label = \"Architectural\"; }"
			"       : txt { label = \"Reverse\"      ; }"
			"       : txt { label = \"Pref/Suff\"    ; }"
			"       : txt { label = \"Add\"          ; }"
			"       : txt { label = \"Delete\"       ; }"
			"       : txt { label = \"Copy\"         ; }"
			"       : txt { label = \"Current\"      ; }"
			"       : txt { label = \"Find\"         ; }"
			"       : txt { label = \"Done\"         ; }"
			"       : txt { label = \"Reset\"        ; }"
			"    }"
			"    : column {"
			"       : txt { label = \"]\"     ; }"
			"       : txt { label = \"]\"     ; }"
			"       : txt { label = \"]\"     ; }"
			"       : txt { label = \"]\"     ; }"
			"       : txt { label = \"]\"     ; }"
			"       : txt { label = \"<--\"   ; }"
			"       : txt { label = \"<--\"   ; }"
			"       : txt { label = \"<--\"   ; }"
			"       : txt { label = \"]\"     ; }"
			"       : txt { label = \"]\"     ; }"
			"       : txt { label = \"]\"     ; }"
			"       : txt { label = \"]\"     ; }"
			"       : txt { label = \"]\"     ; }"
			"       : txt { label = \"]\"     ; }"
			"       : txt { label = \"]\"     ; }"
			"       : txt { label = \"]\"     ; }"
			"       : txt { label = \"]\"     ; }"
			"    }"
			"    spacer;"
			"    : column {"
			"      : ltxt { label = \"Move selected Tabs to the top of the list.\"             ; }"
			"      : ltxt { label = \"Move selected Tabs up one notch in the list.\"           ; }"
			"      : ltxt { label = \"Move selected Tabs down one notch in the list.\"         ; }"
			"      : ltxt { label = \"Move selected Tabs to the bottom of the list.\"          ; }"
			"      : ltxt { label = \"Opens the Sort Dialog.\"                                 ; }"
			"      : ltxt { label = \"Sort the Tabs Alphabetically.\"                          ; }"
			"      : ltxt { label = \"Sort the Tabs Numerically.\"                             ; }"
			"      : ltxt { label = \"Sort the Tabs using an Architectural sorting method.\"   ; }"
			"      : ltxt { label = \"Reverse the Tab Order.\"                                 ; }"
			"      : ltxt { label = \"Opens the Prefix/Suffix Dialog.\"                        ; }"
			"      : ltxt { label = \"Adds a new layout Tab using the next available name.\"   ; }"
			"      : ltxt { label = \"Deletes the selected Tabs.\"                             ; }"
			"      : ltxt { label = \"Copies the selected Tabs.\"                              ; }"
			"      : ltxt { label = \"Makes the selected Tab the Current Tab.\"                ; }"
			"      : ltxt { label = \"Opens the Find and Replace Dialog.\"                     ; }"
			"      : ltxt { label = \"Finished sorting Tabs, will implement sorting.\"         ; }"
			"      : ltxt { label = \"Will reset Tab names and order - not deleted/added Tabs\"; }"
			"    }"
			"  }"
			"  spacer_1;"
			"  : title { label = \"-------------------------------------------------------------\" ; }"
			"  spacer_1; ok_only;"
			"}"
			""
			"//------------------------------------------------------------//"
			"//                        End of File                         //"
			"//------------------------------------------------------------//"
		)
	)
)


;;------------------------------------------------------------;;

(defun _RenameTab ( dchand n lst / nam )
	(cond
		(	(not (new_dialog "rename" dchand))
			(mai_dos_Popup "警告:" 16 "加载重名名对话框出错")
			(princ "\n** 加载重名名对话框出错 **")
			lst
		)
		(	t
			(set_tile  "name" (setq nam (nth n lst)))
			(mode_tile "name" 2)
			(action_tile "name" "(setq nam $value)")
			(action_tile "accept"
				(vl-prin1-to-string
					(quote
						(progn
							(set_tile "error" "")
							(cond
								( (eq "" nam)
									(set_tile "error" "请输入布局名称")
								)
								((wcmatch (strcase nam) "*[<>\\/\\\":;`?`*|`,=]*")
									(set_tile "error" "布局名称中含有不支持的字符")
									(mode_tile "name" 2)
								)
								((vl-position (strcase nam) (mapcar 'strcase (mai_remove_nth lst n 1)))
									(set_tile "error" (strcat nam " 布局名称已经存在!"))
									(mode_tile "name" 2)
								)
								( (done_dialog 1) )
							)
						)
					)
				)
			)

			(if (= 1 (start_dialog))
				(cond
					(	(eq nam (nth n lst)) lst)
					(	(vl-catch-all-error-p
							(vl-catch-all-apply 'vla-put-Name (list (vla-item aclay (nth n lst)) nam))
						)
						(mai_dos_Popup "警告:" 16 "重名名过程出错")
						lst
					)
					(	(subst nam (nth n lst) lst) )
				)
				lst
			)
		)
	)
)

;;------------------------------------------------------------;;


(defun _RemoveItems ( idx lst / i )
	(setq i -1)
	(vl-remove-if '(lambda ( x ) (member (setq i (1+ i)) idx)) lst)
)



;;------------------------------------------------------------;;

(defun _TabSort ( dchand lst )

	(or *SortTyp* (setq *SortTyp*   "0"))
	(or *SortOrd* (setq *SortOrd* "asc"))

	(cond
		(	(not (new_dialog "sort" dchand))
			(mai_dos_Popup "警告:" 16 "加载排序对话框过程出错")
			lst
		)
		(t
			(mai_filldcl_list "typ" '("Alphabetical" "Numerical" "Architectural"))
			(set_tile "typ" *SortTyp*)
			(set_tile *SortOrd*   "1")

			(action_tile "typ" "(setq *SortTyp* $value)")
			(action_tile "asc" "(setq *SortOrd* $key)")
			(action_tile "des" "(setq *SortOrd* $key)")

			(if (zerop (start_dialog))
				lst
				(progn
					(cond
						( (eq "0" *SortTyp*) (setq lst (acad_strlsort lst)) )
						( (eq "1" *SortTyp*) (setq lst (_NumSort lst)) )
						( (eq "2" *SortTyp*) (setq lst (_ArchSort lst)) )
					)
					(if (eq "asc" *SortOrd*) lst (reverse lst))
				)
			)
		)
	)
)

;;------------------------------------------------------------;;


;;------------------------------------------------------------;;

(defun _ArchSort ( lst / comparable ) ; (Gile)
	(defun comparable ( e1 e2 )
		(or (and (numberp e1) (numberp e2))
			(= 'STR (type e1) (type e2))
			(not e1)
			(not e2)
		)
	)
	(mapcar
		'(lambda ( x ) (nth x lst))
		(vl-sort-i
			(mapcar 'mai_str_split lst)
			(function
				(lambda ( x1 x2 / n1 n2 comp )
					(while
						(and
							(setq comp (comparable (setq n1 (car x1)) (setq n2 (car x2))))
							(= n1 n2)
						)
						(setq x1 (cdr x1) x2 (cdr x2))
					)
					(if comp (< n1 n2) (numberp n1))
				)
			)
		)
	)
)

;;------------------------------------------------------------;;

(defun _NumSort ( lst )
	(mapcar
		'(lambda ( x ) (nth x lst))
		(vl-sort-i (mapcar '(lambda ( x ) (vl-remove-if-not 'numberp (mai_str_split x))) lst)
		(function
			(lambda ( a b )
				(while (and a b (= (car a) (car b)))
					(setq a (cdr a) b (cdr b))
				)
				(if (or a b) (< (car a) (car b)) t)
			)
		)
	  )
	)
)

;;------------------------------------------------------------;;

(defun _DeleteTabs ( dchand idx lst / x )
	(cond
		(	(setq x (mai_dos_Popup "删除布局?" 52 "所选的布局将会被永久删除.\n\n确定删除?")))
		(	(new_dialog "delwarn" dchand)
			(action_tile "accept" "(setq x 6) (done_dialog)")
			(start_dialog)
		)
		(	T
			(princ "\n** 加载删除对话框过程出错 **")
		)
	)

	(if (= 6 x)
		(if (vl-catch-all-error-p
				(vl-catch-all-apply
					'(lambda nil (foreach i idx (vla-delete (vla-item aclay (nth i lst)))))
				)
			)
			(mai_dos_Popup "警告:" 16 "删除布局过程出错")
			(setq lst (_RemoveItems idx lst))
		)
	)
	lst
)

;;------------------------------------------------------------;;

(defun _TabPrefixSuffix ( dchand idx lst / item tmp i nn )
	(or *prefdef* (setq *prefdef* 0))
	(cond
		(	(not (new_dialog "prefsuff" dchand))
			(mai_dos_Popup "警告:" 16 "加载前后缀对话框过程出错")
			lst
		)
		(	t
			(set_tile "all" (itoa *prefdef*))
			(set_tile "pref" pref)
			(action_tile "pref"
				(vl-prin1-to-string
					(quote
						(if (or (mai_not_str (setq tmp (get_tile "pref")))
								(wcmatch (strcase tmp) "*[<>\\/\\\":;`?`*|`,=]*")
							)
							(progn
								(set_tile "error" "前缀含有不被支持的字符")
								(mode_tile "pref" 2)
							)
							(progn
								(setq pref tmp)
								(set_tile "preview" (strcat "预览: " pref (mai_trans_num txt_n txt_sty) suff))
							)
						)
					)
				)
			)
			(set_tile "suff" suff)
			(action_tile "suff"
				(vl-prin1-to-string
					(quote
						(if (or (mai_not_str (setq tmp (get_tile "suff")))
								(wcmatch (strcase tmp) "*[<>\\/\\\":;`?`*|`,=]*")
							)
							(progn
								(set_tile "error" "前缀含有不被支持的字符")
								(mode_tile "suff" 2)
							)
							(progn
								(setq suff tmp)
								(set_tile "preview" (strcat "预览: " pref (mai_trans_num txt_n txt_sty) suff))
							)
						)
					)
				)
			)
			(set_tile "txt_n" (itoa txt_n))
			(action_tile "txt_n" "(setq txt_n (atoi $value))(set_tile \"txt_n\" (itoa txt_n))(set_tile \"preview\" (strcat \"预览: \" pref (mai_trans_num txt_n txt_sty) suff))")
			(set_tile "txt_a" (itoa txt_a))
			(action_tile "txt_a" "(setq txt_a (atoi $value))(set_tile \"txt_a\" (itoa txt_a))")
			(mai_filldcl_list "txt_sty" num_styles)
			(mai_setdcl_popup "txt_sty" txt_sty num_styles)
			(action_tile "txt_sty"
				(vl-prin1-to-string
					(quote
						(progn
							(setq txt_sty (atoi $value))
							(set_tile "preview" (strcat "预览: " pref (mai_trans_num txt_n txt_sty) suff))
						)
					)
				)
			)

			(set_tile "preview" (strcat "预览: " pref (mai_trans_num txt_n txt_sty) suff))
			(action_tile "accept"
				(vl-prin1-to-string
					(quote
						(progn
							(cond
								(	(and
										(not (eq "" (setq pref (get_tile "pref"))))
										(wcmatch (strcase pref) "*[<>\\/\\\":;`?`*|`,=]*")
									)
									(set_tile "error" "前缀含有不被支持的字符")
									(mode_tile "pref" 2)
								)
								(	(and
										(not (eq "" (setq suff (get_tile "suff"))))
										(wcmatch (strcase suff) "*[<>\\/\\\":;`?`*|`,=]*")
									)
									(set_tile "error" "后缀含有不被支持的字符")
									(mode_tile "suff" 2)
								)
								(	(and
										(zerop *prefdef*)
										(setq nn (- txt_n txt_a) tmp (mapcar 'strcase (_RemoveItems idx lst)))
										(vl-some
											'(lambda ( x )
												(setq nn (+ nn txt_a))
												(vl-position (strcase (strcat pref (mai_trans_num nn txt_sty) suff)) tmp)
											)
											(mapcar '(lambda ( x ) (nth x lst)) idx)
										)
									)
									(set_tile "error" "修改导致布局名称重复")
									(mode_tile "pref" 2)
								)
								(	(done_dialog 1) )
							)
							(setq lm_tabsort_op (list pref suff txt_n txt_a txt_sty))
						)
					)
				)
			)

			(action_tile "all" "(setq *prefdef* (atoi $value))")

			(if (= 1 (start_dialog))
				(cond
					(	(zerop *prefdef*)
						(setq
							i -1
							lst (mapcar
									'(lambda ( x / y )
										(if (member (setq i (1+ i)) idx)
											(progn
												(setq y (strcat pref (mai_trans_num txt_n txt_sty) suff) txt_n (+ txt_n txt_a))
												(vla-put-name (vla-item aclay x) y)
												y
											)
											x
										)
									)
									lst
								)
						)
					)
					(	t
						(setq lst
								(mapcar
									'(lambda ( x / y )
										(setq y (strcat pref (mai_trans_num txt_n txt_sty) suff) txt_n (+ txt_n txt_a))
										(vla-put-name (vla-item aclay x) y)
										y
									)
									lst
								)
						)
					)
				)
			)
		)
	)
	lst
)

;;------------------------------------------------------------;;

(defun _AddTab ( newla lst / tmp i upp )
	(setq
		tmp newla
		i 0
		upp (mapcar 'strcase lst)
	)
	(while (member (strcase tmp) upp)
		(setq tmp (strcat newla (itoa (setq i (1+ i)))))
	)
	(vla-add aclay tmp)
	(append lst (list tmp))
)

;;------------------------------------------------------------;;

(defun _CopyTab ( idx lst / upp oldname oldlay newname i objlst newlay newblk o )
	(setq upp (mapcar 'strcase lst))
	(foreach x idx
		(setq
			oldname (nth x lst)
			oldlay  (vla-item aclay oldname)
			newname (strcat oldname " (2)")
			i       2
			objlst  nil
		)
		(while (member (strcase newname) upp)
			(setq newname (strcat oldname " (" (itoa (setq i (1+ i))) ")"))
		)
		(setq
			newlay (vla-add aclay newname)
			newblk (vla-get-block newlay)
			lst    (append lst (list newname))
		)
		(vla-copyfrom newlay oldlay)
		(if (vlax-for o (vla-get-block oldlay)
				(setq objlst (cons o objlst))
			)
			(vla-copyobjects acdoc
				(vlax-make-variant
					(vlax-safearray-fill
						(vlax-make-safearray vlax-vbobject (cons 0 (1- (length objlst)))) (reverse objlst)
					)
				)
				newblk
			)
		)
	)
	lst
)

;;------------------------------------------------------------;;

(defun _FindReplaceTab ( dchand lst / fstr rstr found tab idx flen i nstr rlen m n )

	(cond
		(	(not (new_dialog "find" dchand))
			(mai_dos_Popup "警告:" 16 "加载查找替换对话框过程出错")
			lst
		)

		(	t
			(set_tile "ftxt" "")
			(set_tile "fstr" (setq fstr ""))
			(set_tile "rstr" (setq rstr ""))
			(action_tile "fstr" "(set_tile \"ftxt\" \"\") (setq found nil fstr $value)")
			(action_tile "rstr" "(setq rstr $value)")
			(action_tile "fnd"
				(vl-prin1-to-string
					(quote
						(progn
							(cond
								(	found
									(set_tile "ftxt" (caar found))
									(setq
										tab   (cadar  found)
										idx   (caddar found)
										found (cdr    found)
									)
								)
								( t
									(cond
										(	(eq fstr "")
											(set_tile "ftxt" "输入要搜索的文字.")
											(setq found nil tab nil idx nil)
										)
										(t
											(setq flen (strlen fstr) i 0)
											(foreach x lst
												(while (setq i (vl-string-search (strcase fstr) (strcase x) i))
													(setq found
															(cons
																(list
																	(strcat (substr x 1 i) "[" (substr x (1+ i) flen) "]" (substr x (+ i flen 1)))
																	x
																	i
																)
																found
															)
															i (+ i flen)
													)
												)
											)
											(setq found (reverse found))

											(cond
												(	found
													(set_tile "ftxt" (caar found))
													(setq
														tab   (cadar  found)
														idx   (caddar found)
														found (cdr    found)
													)
												)
												(	t
													(set_tile "ftxt" "没搜索到匹配的布局名称.")
													(setq tab nil idx nil)
												)
											)
										)
									)
								)
							)
						)
					)
				)
			)

			(action_tile "rep"
				(vl-prin1-to-string
					(quote
						(progn
							(cond
								(	(not tab)
									(set_tile "ftxt" "没搜索到匹配的布局名称.")
								)
								(	(wcmatch rstr "*[<>\\/\\\":;`?`*|`,=]*")
									(set_tile "ftxt" "搜索文本中含有不被支持的字符.")
								)
								(	(member
										(vl-string-trim " "
											(strcase (setq nstr (strcat (substr tab 1 idx) rstr (substr tab (+ 1 idx flen)))))
										)
										(mapcar 'strcase lst)
									)
									(set_tile "ftxt" "替换将会导致布局名字重复.")
								)
								(	t
									(vla-put-Name (vla-item aclay tab) nstr)
									(set_tile "ftxt" (strcat (get_tile "ftxt") "  ->  " nstr))
									(setq
										lst (subst nstr tab lst)
										found
											(mapcar
												'(lambda ( x )
													(if (eq tab (cadr x))
														(progn
															(if (< idx (setq i (caddr x)))
																(setq i (+ (caddr x) (- (strlen rstr) flen)))
															)
															(setq i (vl-string-search (strcase fstr) (strcase nstr) i))
															(list
																(strcat (substr nstr 1 i) "[" (substr nstr (1+ i) flen) "]" (substr nstr (+ i flen 1)))
																nstr
																i
															)
														)
														x
													)
												)
												found
											)
									)
								)
							)
						)
					)
				)
			)

			(action_tile "repa"
				(vl-prin1-to-string
					(quote
						(progn
							(set_tile "ftxt" "")
							(cond
								(	(eq fstr "")
									(set_tile "ftxt" "输入要搜索的文字.")
									(setq found nil)
								)
								(	(wcmatch rstr "*[<>\\/\\\":;`?`*|`,=]*")
									(set_tile "ftxt" "搜索文本中含有不被支持的字符.")
								)
								( t
									(setq
										n 0
										flen (strlen fstr)
										rlen (strlen rstr)
									)
									(foreach tab lst
										(setq m n i 0 nstr tab)
										(while (setq i (vl-string-search (strcase fstr) (strcase nstr) i))
											(setq
												nstr (strcat (substr nstr 1 i) rstr (substr nstr (+ 1 i flen)))
												i (+ i rlen)
												m (1+ m)
											)
										)
										(or (member (strcase nstr) (mapcar 'strcase lst))
											(progn
												(vla-put-name (vla-item aclay tab) nstr)
												(setq n m lst (subst nstr tab lst))
											)
										)
									)

									(set_tile "ftxt"
										(if (< 0 n)
											(strcat (itoa n) " 个名称被替换.")
											"没搜索到匹配的名称."
										)
									)
								)
							)
						)
					)
				)
			)

			(start_dialog)
		)
	)
	lst
)

;;------------------------------------------------------------;;

(defun _TabSortHelp ( dchand title )
	(cond
		(	(new_dialog "help" dchand)
			(set_tile "htitle" title)
			(start_dialog)
		)
		((mai_dos_Popup "警告:" 16 "加载帮助对话框过程出错"))
	)
)

(defun refleshtabs ()
	(mai_filldcl_list "tabs" dclst)
	(set_tile  "tabs" "")
	(set_tile  "tabs" ptr)
)



;;------------------------------------------------------------;;
	(mini_start nil)
	(mai_last_com "lm_tabsort")
	(setq
		acdoc (vla-get-activedocument (vlax-get-acad-object))
		aclay (vla-get-layouts acdoc)
		num_styles
			(list
				" 1 数字文本  1 2 3 4..."
				" 2 小写英文字母  a b c...,无 i o z"
				" 3 小写英文字母  a b c...,有 i o z"
				" 4 大写英文字母  A B C...,无 I O Z"
				" 5 大写英文字母  A B C...,有 I O Z"
				" 6 罗马数字  Ⅰ Ⅱ Ⅲ Ⅳ Ⅴ Ⅵ Ⅶ Ⅷ Ⅸ Ⅹ"
				" 7 括号中文数字  ㈠㈡㈢㈣㈤㈥㈦㈧㈨㈩"
				" 8 圆圈阿拉伯数字  ①②③④⑤⑥⑦⑧⑨⑩"
				" 9 括号阿拉伯数字  ⑴⑵⑶⑷⑸⑹⑺⑻⑼⑽"
				"10 中文数字  一二三四五六七八九十"
				"11 中文数字  壹贰叁肆伍陆柒捌玖拾"
			)
	)
	(or lm_tabsort_op (setq lm_tabsort_op (list "" "" 1 1 0)))
	(mapcar 'set '(pref suff txt_n txt_a txt_sty) lm_tabsort_op)
	(or (setq old_dcl_load (_WriteDCL))
		(exit)
	)
	(new_dialog "tabsort" old_dcl_load)
	(setq
		dclst  (mapcar 'vla-get-Name (_GetLayouts aclay))
		resLst dclst
		ptr (if (zerop (getvar 'TILEMODE))
				(itoa (vl-position (getvar 'CTAB) dclst))
				"0"
			)
	)
	(set_tile "dcltitle" "布局排序")
	(refleshtabs)

	(action_tile "tabs"
		(vl-prin1-to-string
			(quote
				(progn
					(setq ptr $value)
					(if (= 4 $reason)
						(progn
							(setq dclst (_RenameTab old_dcl_load (atoi ptr) dclst))
							(refleshtabs)
						)
					)
				)
			)
		)
	)

	(action_tile "up"
		(vl-prin1-to-string
			(quote
				(progn
					(setq
						dclst (mai_List_Up dclst (_value->list ptr))
						ptr (_list->value (cadr dclst))
						dclst (car dclst)
					)
					(refleshtabs)
				)
			)
		)
	)

	(action_tile "down"
		(vl-prin1-to-string
			(quote
				(progn
					(setq
						dclst (mai_List_Down dclst (_value->list ptr))
						ptr (_list->value (cadr dclst))
						dclst (car dclst)
					)
					(refleshtabs)
				)
			)
		)
	)

	(action_tile "mtop"
		(vl-prin1-to-string
			(quote
				(progn
					(setq
						dclst (mai_List_totop dclst (_value->list ptr))
						ptr (_list->value (cadr dclst))
						dclst (car dclst)
					)
					(refleshtabs)
				)
			)
		)
	)

	(action_tile "mbot"
		(vl-prin1-to-string
			(quote
				(progn
					(setq
						dclst (mai_List_tobot dclst (_value->list ptr))
						ptr (_list->value (cadr dclst))
						dclst (car dclst)
					)
					(refleshtabs)
				)
			)
		)
	)

	(action_tile "sort"
		(vl-prin1-to-string
			(quote
				(progn
					(setq
						idx (_value->list ptr)
						old (mapcar '(lambda ( x ) (nth x dclst)) idx)
						dclst (_TabSort old_dcl_load dclst)
						ptr (_list->value (mapcar '(lambda ( x ) (vl-position x dclst)) old))
					)
					(refleshtabs)
				)
			)
		)
	)

	(action_tile "rev"
		(vl-prin1-to-string
			(quote
				(progn
					(setq dclst (car (mai_List_fun dclst (_value->list ptr) 'reverse)))
					(refleshtabs)
				)
			)
		)
	)

	(action_tile "del"
		(vl-prin1-to-string
			(quote
				(progn
					(setq
						idx (_value->list ptr)
						old (mapcar '(lambda ( x ) (nth x dclst)) idx)
						tmp dclst
						newres (_RemoveItems
									(mapcar '(lambda ( x ) (1- (vla-get-TabOrder (vla-item aclay x)))) old)
									resLst
								)
						dclst
							(cond
								( (_DeleteTabs old_dcl_load idx dclst) )
								( (mapcar 'vla-get-Name (_GetLayouts aclay)) )
							)
					)
					(or (equal tmp dclst) (setq resLst (cond (newres) (dclst))))
					(setq ptr
							(if (zerop (getvar 'TILEMODE))
								(itoa (vl-position (getvar 'CTAB) dclst))
								"0"
							)
					)
					(refleshtabs)
				)
			)
		)
	)

	(action_tile "p_s"
		(vl-prin1-to-string
			(quote
				(progn
					(setq dclst (_TabPrefixSuffix old_dcl_load (_value->list ptr) dclst))
					(refleshtabs)
				)
			)
		)
	)

	(action_tile "res"
		(vl-prin1-to-string
			(quote
				(progn
					(cond
						(	(mai_remove_same (mapcar 'strcase resLst))
							(mai_dos_Popup "提示" 48 "重置会导致布局名称重复")
						)
						(	t
							(setq dclst resLst)
							(mapcar 'vla-put-Name (_GetLayouts aclay) resLst)
							(setq ptr
									(if (zerop (getvar 'TILEMODE))
										(itoa (vl-position (getvar 'CTAB) dclst))
										"0"
									)
							)
							(refleshtabs)
						)
					)
				)
			)
		)
	)

	(action_tile "add"
		(vl-prin1-to-string
			(quote
				(progn
					(setq
						dclst (_AddTab "Layout" dclst)
						resLst (mai_cons_last (last dclst) resLst)
						ptr (itoa (1- (length dclst)))
					)
					(refleshtabs)
				)
			)
		)
	)

	(action_tile "cur"
		(vl-prin1-to-string
			(quote
				(progn
					(setq ptr (car (_value->list ptr)))
					(setvar "ctab" (nth ptr dclst))
					(set_tile "tabs" (setq ptr (itoa ptr)))
				)
			)
		)
	)

	(action_tile "copy"
		(vl-prin1-to-string
			(quote
				(progn
					(setq
						idx (_value->list ptr)
						tmp dclst
						i   (1- (length dclst))
						j   i
						dclst (_CopyTab idx dclst)
						resLst (append resLst (mapcar '(lambda ( x ) (nth (setq i (1+ i)) dclst)) idx))
						ptr (_list->value (mapcar '(lambda ( x ) (setq j (1+ j))) idx))
					)
					(refleshtabs)
				)
			)
		)
	)

	(action_tile "fnr"
		(vl-prin1-to-string
			(quote
				(progn
					(setq dclst (_FindReplaceTab old_dcl_load dclst))
					(refleshtabs)
				)
			)
		)
	)

	(action_tile "help" "(_TabSortHelp old_dcl_load \"TabSort iMin - Help\")")

	(start_dialog)
	(unload_dialog old_dcl_load)

	(cond
		(	(equal
				(setq dclst (mapcar 'strcase dclst))
				(mapcar 'strcase (mapcar 'vla-get-Name (setq aclays (_GetLayouts aclay))))
			)
		)

		(	t
			(foreach lay aclays
				(vla-put-TabOrder lay (1+ (vl-position (strcase (vla-get-Name lay)) dclst)))
			)
		)
	)
	(mai_end)
)
(princ)

;;------------------------------------------------------------;;
;;                         End of File                        ;;
;;------------------------------------------------------------;;
