;布局增减及重排序[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
   _listdown
   _listtobottom
   _listtotop
   _listup
   _numsort
   _removeitems
   _removenth
   _renametab
   _reverseitems
   _splitstr
   _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
  ;*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 {"
            "      : spacer { alignment = centered; width = 10; }"
            "      : text   { alignment = centered; label = \"< 名称 >\"; }"
            "    }"
            "    : column {"
            "      : text { alignment = centered; label = \"后缀\"; }"
            "      : eBox { key = \"suff\"; edit_width = 15; edit_limit = 255; }"
            "    }"
            "  }  "
            "  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 _RemoveNth ( n l )
    (if (and l (< 0 n))
      (cons (car l) (_RemoveNth (1- n) (cdr l)))
      (cdr l)
    )
  )

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

  (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" "Please Enter a Tab Name")
                  )
                  ((wcmatch (strcase nam) "*[<>\\/\\\":;`?`*|`,=]*")
                    (set_tile "error" "Invalid Symbol in Tab Name")
                    (mode_tile "name" 2)
                  )
                  ((vl-position (strcase nam) (mapcar 'strcase (_RemoveNth n lst)))
                    (set_tile "error" (strcat nam " already exists!"))
                    (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 _ListUp ( ind lst / tt ) ; (Gile)
    (setq tt (car ind))
    (cond
      ( (or (null tt) (null lst))
        lst
      )
      ( (= 0  tt)
        (cons (car  lst) (_ListUp (cdr (mapcar '1- ind)) (cdr lst)))
      )
      ( (= 1 tt)
        (cons (cadr lst) (_ListUp (cdr (mapcar '1- ind)) (cons (car lst) (cddr lst))))
      )
      ( t
        (cons (car lst) (_ListUp (mapcar '1- ind) (cdr lst)))
      )
    )
  )

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

  (defun _ListDown ( idx lst )
    (reverse
      (_ListUp
        (reverse
          (mapcar '(lambda ( x ) (- (1- (length lst)) x)) idx)
        )
        (reverse lst)
      )
    )
  )

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

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

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

  (defun _ListToTop ( idx lst )
    (append (mapcar '(lambda ( i ) (nth i lst)) idx) (_RemoveItems idx lst))
  )

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

  (defun _ListToBottom ( idx lst ) 
    (append (_RemoveItems idx lst) (mapcar '(lambda ( i ) (nth i lst)) idx))
  )

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

  (defun _ReverseItems ( idx lst )
    (
      (lambda ( i l )
        (mapcar
          (function
            (lambda ( x )
              (if (member (setq i (1+ i)) idx)
                (setq x (nth (car l) lst)
                      l (cdr l)
                )
              )
              x
            )
          )
          lst
        )
      )
      -1 (reverse (vl-sort idx '<))
    )
  )

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

  (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 _SplitStr ( str / lst test rslt num tmp ) ; (Gile)
    (setq lst  (vl-string->list str)
          test (chr (car lst))
    )    
    (if (< 47 (car lst) 58)
      (setq num T)
    )
    (while (setq lst (cdr lst))
      (if num
        (cond
          ( (= 46 (car lst))
            (if
              (and
                (cadr lst)
                (setq tmp (strcat "0." (chr (cadr lst))))
                (numberp (read tmp))
              )
              (setq rslt (cons (read test) rslt)
                    test tmp
                    lst  (cdr lst)
              )
              (setq rslt (cons (read test) rslt)
                    test "."
                    num nil
              )
            )
          )
          ( (< 47 (car lst) 58) (setq test (strcat test (chr (car lst)))) )
          ( t
            (setq rslt (cons (read test) rslt)
                  test (chr (car lst))
                  num  nil
            )
          )
        )
        (if (< 47 (car lst) 58)
          (setq rslt (cons test rslt)
                test (chr (car lst))
                num  T
          )
          (setq test (strcat test (chr (car lst))))
        )
      )
    )
    (reverse (cons (if num (read test) test) rslt))
  )

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

  (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 '_SplitStr 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 (_SplitStr 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确定删除?")))
      ( (not (new_dialog "delwarn" dchand))
        (princ "\n** 加载删除对话框过程出错 **")
      )
      (t (action_tile "accept" "(setq x 6) (done_dialog)")
         (start_dialog)
      )
    )

    (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 / pref suff item tmp i )
    
    (or *prefdef* (setq *prefdef* 0))
    
    (cond
      ( (not (new_dialog "prefsuff" dchand))
        (mai_dos_Popup "警告:" 16 "加载前后缀对话框过程出错")
        lst
      )
      (t
        (set_tile "all" (itoa *prefdef*))
        (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 tmp (mapcar 'strcase (_RemoveItems idx lst)))
                         (vl-some '(lambda ( x )
                                       (vl-position (strcase (strcat pref x suff)) tmp)
                                    )
                                    (mapcar '(lambda ( x ) (nth x lst)) idx) 
                         )
                    )
                    (set_tile "error" "修改导致布局名称重复")
                    (mode_tile "pref" 2)
                  )
                  ( (done_dialog 1) )
                )
              )
            )
          )
        )

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

        (if (= 1 (start_dialog))
          (cond
            ( (zerop *prefdef*)
              (setq i -1
                    lst (mapcar
                           '(lambda ( x )
                                (if (member (setq i (1+ i)) idx)
                                    (progn
                                      (vla-put-name (vla-item aclay x) (strcat pref x suff))
                                      (strcat pref x suff)
                                    )
                                    x
                                )
                            )
                            lst
                        )
              )
            )
            ( t
              (setq lst (mapcar
                           '(lambda ( x )
                              (vla-put-name (vla-item aclay x) (strcat pref x suff))
                              (strcat pref x suff)
                            )
                            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 )
    (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" ptr)
  )

;;------------------------------------------------------------;;
  (mini_start nil)
  (mai_last_com "lm_tabsort")
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
        aclay (vla-get-layouts acdoc)
  )
  (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 idx (_value->list ptr)
                old (mapcar '(lambda ( x ) (nth x dclst)) idx)
                dclst (_ListUp idx dclst)
                ptr (_list->value (mapcar '(lambda ( x ) (vl-position x dclst)) old))
          )
          (refleshtabs)
        )
      )
    )
  )
     
  (action_tile "down"
    (vl-prin1-to-string
      (quote
        (progn
          (setq
            idx (_value->list ptr)
            old (mapcar '(lambda ( x ) (nth x dclst)) idx)
            dclst (_ListDown idx dclst)
            ptr (_list->value (mapcar '(lambda ( x ) (vl-position x dclst)) old))
          )
          (refleshtabs)
        )
      )
    )
  )

  (action_tile "mtop"
    (vl-prin1-to-string
      (quote
        (progn
          (setq idx (_value->list ptr)
                dclst (_ListToTop idx dclst)
                i -1
                ptr (_list->value (mapcar '(lambda ( x ) (setq i (1+ i))) idx))
          )
          (refleshtabs)
        )
      )
    )
  )

  (action_tile "mbot"
    (vl-prin1-to-string
      (quote
        (progn
          (setq idx (_value->list ptr)
                dclst (_ListToBottom idx dclst)
                i (length dclst)
                ptr (_list->value (reverse (mapcar '(lambda ( x ) (setq i (1- i))) idx)))
          )
          (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 (_ReverseItems (_value->list ptr) dclst))
          (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                        ;;
;;------------------------------------------------------------;;