Liren Large Software Subsidy 13/13.iso/p/p024/5.img/SUPPORT2.LIB/DDRENAME.LSP

Text File | 1993-02-08 | 18.8 KB | 531 lines

;;;----------------------------------------------------------------------------
;;;
;;;   DDRENAME.LSP   ¬⌐Ñ╗ 0.5
;;;
;;;   ¬⌐┼v (C) 1991-1992  Autodesk ñ╜Ñq
;;;
;;;   Ñ╗│n┼ΘºK╢O¿╤▒z╢iªµÑ⌠ª≤Ñ╬│~╗▌¿D¬║½■¿⌐íB¡╫º∩ñ╬╡oªµ, ª²¼O░╚╜╨┐φ┤`ñU¡z
;;;   ¡∞½h :
;;;
;;;   1)  ñWªC¬║¬⌐┼v│qºi░╚╗▌ÑX▓{ªb¿Cñ@Ñ≈½■¿⌐∙╪íC
;;;   2)  ¼█├÷¬║╗í⌐·ñσÑ≤ñ]Ñ▓╢╖⌐·╕ⁿ¬⌐┼v│qºiñ╬Ñ╗╢╡│\Ñi│qºiíC
;;;
;;;   Ñ╗│n┼Θ╢╚┤ú¿╤º@¼░└│Ñ╬ñW¬║░╤ª╥, ª╙Ñ╝┴n⌐·⌐╬┴⌠ºtÑ⌠ª≤½O├╥; ╣∩⌐≤Ñ⌠ª≤»S«φ
;;;   Ñ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºtÑX¿π¬║½O├╥, ªbª╣ñ@╖ºñ⌐ÑHº_╗{íC
;;;
;;;
;;;----------------------------------------------------------------------------
;;;  DESCRIPTION
;;;
;;;  An AutoLISP implementation of the AutoCAD command RENAME with a dialogue
;;;  interface.  Unlike its command counterpart, DDRENAME supports wildcard
;;;  matching (* and ?), requested particularly by users for manipulating
;;;  bound Xref symbol table items (aka named objects) with long names.
;;;
;;;  DESIGN OUTLINE
;;;
;;;  For each table selected a list is generated of items in that table.
;;;  Renamed items are substituted into the list and on OK this new list
;;;  is compared to the original list and differing items are put through
;;;  the AutoCAD rename command.
;;;
;;;----------------------------------------------------------------------------
;;;   Prefixes in command and keyword strings:
;;;      "."  specifies the built-in AutoCAD command in case it has been
;;;           redefined.
;;;      "_"  denotes an AutoCAD command or keyword in the native language
;;;           version, English.
;;;----------------------------------------------------------------------------
;;;
;;; ===========================================================================
;;; ===================== load-time error checking ============================
;;;

  (defun ai_abort (app msg)
     (defun *error* (s)
        (if old_error (setq *error* old_error))
        (princ)
     )
     (if msg
       (alert (strcat " └│Ñ╬╡{ªí┐∙╗~: "
                      app
                      " \n\n  "
                      msg
                      "  \n"
              )
       )
     )
     (exit)
  )

;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.

  (cond
     (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.

     (  (not (findfile "ai_utils.lsp"))                     ; find it
        (ai_abort "DDRENAME"
                  (strcat "ºΣñú¿∞íuAI_UTILS.LSPív└╔«╫;"
                          "\n  ╜╨└╦¼díusupportívÑ╪┐²íC")))

     (  (eq "failed" (load "ai_utils" "failed"))            ; load it
        (ai_abort "DDRENAME" "╡L¬k╕ⁿñJíuAI_UTILS.LSPív└╔«╫"))
  )

  (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
      (ai_abort "DDRENAME" nil)         ; a Nil <msg> supresses
  )                                    ; ai_abort's alert box dialog.

;;; ==================== end load-time operations ===========================

;;;----------------------------------------------------------------------------
;;;  The main function.
;;;----------------------------------------------------------------------------
(defun c:ddrename (/
        $value                             olderr               style_items
                          globals          old_cmd              tables
        block_items       highlight        old_indices          table_item
        chflag            i                old_pattern          table_items
        cmd               item1            old_pattern_length   table_list
        cmd_old           item2            old_star             table_name
        command_rename    j                one_index            table_selection
        count             just_name        orig_list            ucs_items
        current_items     layer_items      pat_length           update_list
        dcl_id            list1            pat_letter           view_items
        list_name_new                      pick_items           vport_items
        defined_names     ltype_items      rename               undo_init
        dimstyle_items    n                rename_err
        ddrename_main     n1               rename_list
        do_new            new_item_list    report_error
        do_old            new_name         rs_error
        do_tables1        new_name_list    s
        do_tables2        new_pattern
       )
  ;;
  ;; Action on Old Name edit box.
  ;;
  (defun do_old()
    (set_tile "table_items" "")
    (rs_error)
    (setq report_error 1)
    (do_old)
  )
  ;;
  ;; Reset the error tile.
  ;;
  (defun rs_error()
    (set_tile "error" "")
  )
  ;;
  ;; This routine is called when a pick is made in the table list box, the
  ;; one that displays Block, Layer, Linetype, etc.
  ;;
  (defun table_selection()
    (set_tile "error" "")               ; Clear the error tile.
    (do_tables1)                        ; Display items in selected table.
    (if (= "*varies*" (get_tile "old")) ; If old name is *varies*,
      (set_tile "old" "")                 ; clear it,
      (progn                              ; else use it to highlight new items.
        (setq report_error 0)
        (do_old)
      )
    )
  )
  ;;
  ;; This routine is called when a pick is made in the table items list box,
  ;; the one that displays the items in the selected table.
  ;;
  (defun table_items()
    (set_tile "error" "")               ; clear the error tile.
    (setq pick_items (get_tile "table_items"))   ; find the highlight items.
    (cond
      ((= "" pick_items) (set_tile "old" ""))    ; no items selected
      ((= "" (substr pick_items (+ 2 (strlen (itoa (read pick_items))))))
        (set_tile "old" (nth (atoi $value) current_items)) ; if 1 item selected
      )                                                    ; display its name.
      (T (set_tile "old" "*varies*"))          ; else display *varies*.
    )
  )
  ;;
  ;;  This routine displays a new title on the table item list box.
  ;;
  (defun do_tables1()
    (setq table_name (nth (atoi $value) tables))

    ;; This (cond) is added for translation purposes.  The list of symbol
    ;; tables in the dialogue box will appear in the local language but
    ;; they must be translated to American so that AutoCAD can understand.
    ;; When translating these strings make sure they correspond exactly
    ;; and precisely to those modified in the table list defined at the
    ;; start of the ddrename_main() function further down the file.
    (cond
      ((= table_name "Block")         ; translate this
        (setq table_name "block")     ; do not translate
      )
      ((= table_name "Dimstyle")      ; translate this
        (setq table_name "dimstyle")  ; do not translate
      )
      ((= table_name "Layer")         ; translate this
        (setq table_name "layer")     ; do not translate
      )
      ((= table_name "Ltype")         ; translate this
        (setq table_name "ltype")     ; do not translate
      )
      ((= table_name "Style")         ; translate this
        (setq table_name "style")     ; do not translate
      )
      ((= table_name "Ucs")           ; translate this
        (setq table_name "ucs")       ; do not translate
      )
      ((= table_name "View")          ; translate this
        (setq table_name "view")      ; do not translate
      )
      ((= table_name "Vport")         ; translate this
        (setq table_name "vport")     ; do not translate
      )
    )
    (do_tables2)
  )
  ;;
  ;; Displays the defined items in a the selected table.
  ;;
  (defun do_tables2()
    ;; If this is the first time this table is selected, set the "table"_items
    ;; list to the currently defined items in the drawing by using ai_table.
    (if (not (eval (read (strcat table_name "_items"))))
      (set (read (eval (strcat table_name "_items")))
           (ai_table table_name 7)
      )
    )
    ;; Set current_items to a sorted version of "table"_items.
    (if (and (>= (getvar "maxsort")
               (length (eval (read (strcat table_name "_items"))))
             )
             (eval (read (strcat table_name "_items")))
        )
      (setq current_items
            (acad_strlsort (eval (read (strcat table_name "_items"))))
      )
      (setq current_items (eval (read (strcat table_name "_items"))))
    )
    (start_list "table_items")          ; display the sorted version.
    (mapcar 'add_list current_items)
    (end_list)
  )
  ;;
  ;; On Apply, check input, generate lists, and update the new list if all
  ;; is well.
  ;;
  (defun rename()
    (setq report_error 1)
    (and (do_old)
         (do_new)
         (update_list)
    )
    (setq report_error 0)
  )
  ;;
  ;; Validation checking for old name.  Called on OK and when focus is removed
  ;; from the old name edit box.
  ;;
  (defun do_old()
    (setq rename_list '())
    (setq new_name_list '())
    (cond
      ((and (/= "" (setq old_pattern (ai_strtrim (get_tile "old"))))
            (/= "*varies*" old_pattern))
        (setq i 0)
        (setq j 1)
        (setq old_star nil)
        (setq highlight "")
        ; Find first * in old_pattern.
        (setq old_pattern_length (strlen old_pattern))
        (while (<= j old_pattern_length)
          (cond
            ((= "*" (substr old_pattern j 1)) (setq old_star j))
             (T)
           )
           (setq j (1+ j))
        )
        (if (not (wcmatch old_pattern
                        "*[]`#`@`.`~`[`,`'!%^&()+={}|`\\:;\"<>/]*"
                 )
            )
          (progn
            (foreach n current_items
              (if (wcmatch n (strcase old_pattern))
                (progn
                  (setq rename_list (cons n rename_list))
                  (set_tile "table_items" (itoa i))
                  (setq highlight (strcat highlight (itoa i) " "))
                )
              )
              (setq i (1+ i))
            )
          )
        )
        (if rename_list
          (progn
            (set_tile "table_items" highlight)
             T)                ; if there is a list return T to continue
          (progn
            (if (= 1 report_error)
              (set_tile "error" "íu┬┬ªW║┘ív╡L«─íC")
            )
            nil             ; else set errtile and drop out.
          )
        )
      )
      (T
        (if (/= "" (setq old_indices (get_tile "table_items"))) ; get indices
          (progn
            (setq old_star 1)
            (while (read old_indices)                 ; while an index remains
              (setq one_index (itoa (read old_indices)))    ; get first index
              (setq old_indices (substr old_indices (+ 2 (strlen one_index))))
                                                            ; chop from string
              (setq rename_list
                    (cons (nth (atoi one_index) current_items) rename_list)
              )
            )
          )
          (progn
            (if (= 1 report_error)
              (set_tile "error" "Ñ╝┐∩¿∞íu┬┬ªW║┘ívíC")
            )
            nil
          )
        )
      )
    )
  )
  ;;
  ;; Check the validity of new name and generates new names.
  ;;
  (defun do_new()
    (setq new_pattern (strcase (ai_strtrim (get_tile "new"))))
    (foreach n1 rename_list
      (setq pat_length (strlen new_pattern)
            i          1
            new_name   ""
      )
      (while (<= i pat_length)
        (setq pat_letter (substr new_pattern i 1))
        (cond
          ((= "*" pat_letter)
            (cond
              ((and old_star
                    (>= (strlen n1) old_star)
               )
                ;; if there is a * in old_pattern and the length of the old
                ;; name is longer then tag the rest of the letters on.
                (setq new_name (strcat new_name (substr n1 old_star)))
              )
              (T (setq new_name (strcat new_name (substr n1 i))) )
            )
            (setq i (1+ pat_length))
          )
          ((wcmatch pat_letter "@,#,_,-,$")
            (setq new_name (strcat new_name (substr new_pattern i 1))
               i        (1+ i)
            )
          )
          ((= "?" pat_letter)
            (setq new_name (strcat new_name (substr n1 i 1))
                  i        (1+ i)
            )
          )
          (T (setq new_name "")(setq i (1+ pat_length)))
          ; if weird characters, set new_name to null and catch it later.
        )
      )
      (setq new_name_list (cons new_name new_name_list))
    )
    (setq i             -1
          list_name_new (reverse new_name_list)
          defined_names (ai_table table_name 7)
    )

    (while (< i (- (length list_name_new) 1))
      (setq i (1+ i)
            n (nth i list_name_new)
      )
      (cond
        ;; It's OK to rename an item back to original name.  If the new item
        ;; is a member of the original list of items and its position in the
        ;; original list corresponds to the position of the new name then the
        ;; user is renaming an item back to its original name.  If it doesn't
        ;; correspond then give an error message.
        ((and (member n defined_names)
              (/= (length (member n defined_names)) ; old position in list
                  (length (member (nth i rename_list) ; new position
                                  (eval (read (strcat table_name "_items")))
                          )
                  )
              )
         )
         (set_tile "error" "íu╖sªW║┘ív╡L«─íC")
         (setq i (1+ (length list_name_new)))  ; break out
        )
        ((> (strlen n) 31)
         (set_tile "error" "╡L«─ í╨ ╖sªW║┘╢W╣L 31 ¡╙ªrñ╕íC")
         (setq i (1+ (length list_name_new)))  ; break out
        )
        ((= "" n)
         (set_tile "error" "íu╖sªW║┘ív╡L«─íC")
         (setq i (1+ (length list_name_new)))  ; break out
        )
        ((member n (cdr (member n new_name_list)))
         (set_tile "error" "╡L«─ í╨ ╖sªW║┘íu¡½╜╞ívíC")
         (setq i (1+ (length list_name_new)))  ; break out
        )
        ((member n (eval (read (strcat table_name "_items"))))
         (set_tile "error" "╡L«─ í╨ ╖sªW║┘íu¡½╜╞ívíC")
         (setq i (1+ (length list_name_new)))  ; break out
        )
        (T (set (read (eval (strcat table_name "_items")))
                (subst
                      n                                            ; new
                      (nth i rename_list)                          ; old
                      (eval (read (strcat table_name "_items"))))) ; list
        )
      )
    )
    (if (= i (- (length list_name_new) 1))
      (progn
        (if (and (>= (getvar "maxsort") (length list_name_new))
                 (eval (read (strcat table_name "_items")))
            )
          (setq current_items
            (acad_strlsort (eval (read (strcat table_name "_items"))))
          )
          (setq current_items (eval (read (strcat table_name "_items"))))
        )
      )
      nil
    )
  )
  ;;
  ;; Called by Apply, substitutes the new name for the current item name.
  ;;
  (defun update_list(/ i)
    (setq i             0
          new_item_list current_items
    )
    (foreach n rename_list
      (setq new_item_list (subst (nth i list_name_new) n new_item_list)
            i             (1+ i)
      )
    )
    (start_list "table_items")
    (mapcar 'add_list new_item_list)
    (end_list)
    (setq chflag 1)
    (if (= "*varies*" old_pattern) (set_tile "old" ""))  ; clear old name.
    T
  )
  ;;
  ;; If all input checks out, then for each table that has a corresponding
  ;; old name and new name list, corresponding items in the old list and the new
  ;; list are compared and renamed if different.  For each updated table, a
  ;; message reporting the number of items renamed is displayed.
  ;;
  (defun command_rename(/ orig_list count)
    (foreach n tables
      (setq count 0)
      (if (eval (read (strcat n "_items")))
        (progn
          (setq orig_list (ai_table n 7))
          (setq i 0)
          (foreach n1 (eval (read (strcat n "_items")))
            (if (not (wcmatch n1 (nth i orig_list)))
              (progn
                (command "_.rename" n (nth i orig_list) n1)
                (setq count (1+ count))
              )
            )
            (setq i (1+ i))
          )
          (if (/= count 0)
            (princ (strcat "\n" (itoa count) " " n " ╢╡│Qíuº≤ªWívíC"))
          )
        )
      )
    )
  )
  ;;
  ;; Put up the dialogue.
  ;;
  (defun ddrename_main()

    (if (not (new_dialog "ddrename" dcl_id)) (exit))
    ;; This is the list of symbol table names that are dispalyed in the
    ;; listbox.  When translating these strings, make sure that the (cond)
    ;; in  do_tables1() is updated to contain exact copies of these strings.
    ;; Re-ordering this list for alphabetising purposes should not cause
    ;; problems, but test it thoroughly.

    (setq tables
          '("Block" "Dimstyle" "Layer" "Ltype" "Style" "Ucs" "View" "Vport"))

    (setq chflag       0      ; OK needs to know if anything has changed
          report_error 0)     ; Only print the old name errors during Apply.

    (start_list "tables")
    (mapcar 'add_list tables)
    (end_list)

    ;; Make layer the default selection and display layer list.
    (set_tile "tables" "2")
    (setq table_name "Layer")
    (set_tile "table_type" "╝hªW")
    (do_tables2)

    (action_tile "tables" "(table_selection)")
    (action_tile "table_items" "(table_items)")
    (action_tile "old" "(do_old)")
    (action_tile "new" "(rs_error)")
    (action_tile "rename" "(rs_error)(rename)")
    (action_tile "accept" "(done_dialog 1)")
    (action_tile "help" "(acad_helpdlg \"acad.hlp\" \"ddrename\")")

    (if (and (= 1 (start_dialog)) (= 1 chflag))
      (command_rename)
      (princ "\n¿Sª│╢╡Ñ╪│Qíuº≤ªWívíC ")
    )
  )

  ;; Set up error function.
  (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
        old_error  *error*            ; save current error function
        *error* ai_error              ; new error function
  )

  (setvar "cmdecho" 0)

  (cond
     (  (not (ai_notrans)))                      ; transparent not OK
     (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
     (  (not (setq dcl_id (ai_dcl "ddrename"))))  ; is .DCL file loaded?

     (t
        (ai_undo_push)
        (ddrename_main)                          ; proceed!
        (ai_undo_pop)
     )
  )

  (setq *error* old_error)
  (setvar "cmdecho" old_cmd)
  (princ)
)

;;;----------------------------------------------------------------------------
(princ "  íuDDRENAMEívñw╕ⁿñJíC")
(princ)