Windows 95 v2.4 Fix/W95-v2.4fix.iso/ACADWIN/SUPPORT/DDVIEW.LSP

Lisp/Scheme | 1995-02-08 | 25.0 KB | 757 lines

; Next available MSG number is    26
; MODULE_ID DDVIEW_LSP_
;;;
;;;    ddview.lsp
;;;
;;;    Copyright (C) 1992, 1994 by Autodesk, Inc.
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;    UNINTERRUPTED OR ERROR FREE.
;;;
;;;    Use, duplication, or disclosure by the U.S. Government is subject to
;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;;    (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;.
;;;    DESCRIPTION
;;;
;;;    Dialogue interface to VIEW command.  Uses DDVIEW.DCL
;;;
;;;----------------------------------------------------------------------------
;;;    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 " Error en la aplicaci≤n: "
                      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 ;|MSG0|;"ai_utils.lsp"))                     ; find it
        (ai_abort "DDVIEW"
                  (strcat "Imposible localizar el  archivo AI_UTILS.LSP."
                          "\n Compruebe el directorio de soporte.")))

     (  (eq ;|MSG0|;"failed" (load "ai_utils" ;|MSG0|;"failed"))            ; load it
        (ai_abort "DDVIEW" "Imposible cargar el archivo AI_UTILS.LSP"))
  )

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

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

;;;
;;; DDVIEW code.
;;;
(defun c:ddview ( /
                ai_abort        lboxlist          restore_view       vt
                appname         lboxname          rm_item            vtar
                check_name      list_no           s                  what_next
                dcl_id          make-lists        save_view          what_next1
                delete          name              temp_lisp_list     what_space
                delete_list     named_others      the_list           which_save
                describe        new_names         update_list        wid
                enable_rad      new_others        value              wview
                errmsg          new_view          vcen               x1y1
                                new_view_name     vdir               x2
                grey_des        no_redefine       viewname           x2y2
                hi              old_cmd           viewtype           y1
                init_list       old_error                            y2
                j               picked_no         vmode              undo_init
                lab             restorable
                                restore           vnlist
         )
  ;;
  ;; Pass an item and a list and recieve a number showing it's position in
  ;; the list, nil otherwise.  Item must be in the list, and the list must
  ;; contain unique names. 0 if first item.
  ;;
  (defun what_pos (item the_list / pos)
    (setq pos (- (length the_list)
                 (length (member item the_list)))
    )
  )
  ;;
  ;; Get information for description of new (not existing yet) views.
  ;;
  (defun new_others()
    (if (cdr (assoc viewname new_names))
      (progn
        (setq wid (abs (- x2 x1)))
        (setq hi (abs (- y2 y1)))
      )
      (progn
        (setq wid (/ (* (getvar "viewsize") (abs (- x2 x1)))
                     (abs (- y2 y1))
                  )
        )
        (setq hi (getvar "viewsize"))
      )
    )
    (set_tile ;|MSG0|;"v_height" (rtos hi))
    (set_tile ;|MSG0|;"v_width" (rtos wid))
    (set_tile ;|MSG0|;"v_twist" (angtos (getvar "viewtwist")))
    (set_tile ;|MSG0|;"lens" (rtos (getvar "lenslength")))
    (set_tile ;|MSG0|;"fclip" (rtos (getvar "frontz")))
    (set_tile ;|MSG0|;"bclip" (rtos (getvar "backz")))

    ;; Viewdir is stored in UCS (yeah UCS)
    (setq vdir (getvar "viewdir"))
    (if (= 1 wview)
      (setq vdir (trans vdir 1 0 T))
    )
    (set_tile ;|MSG0|;"vdir_x" (rtos (car vdir)))
    (set_tile ;|MSG0|;"vdir_y" (rtos (cadr vdir)))
    (set_tile ;|MSG0|;"vdir_z" (rtos (caddr vdir)))

    (setq vmode (getvar "viewmode"))
    (if (= (logand 2 vmode) 2)
      (set_tile "fclipon" "ACT")
      (set_tile "fclipon" "DES")
    )
    (if (= (logand 4 vmode) 4)
      (set_tile "bclipon" "ACT")
      (set_tile "bclipon" "DES")
    )
    (if (= (logand 1 vmode) 1)
      (progn
        (set_tile "persp" "ACT")
        (if (= 1 wview)
          (setq lab "Motivo (SCU)")
          (setq lab "Motivo (SCP)")
        )
        (set_tile ;|MSG0|;"cen_tar" lab)
        (setq vtar (getvar "target"))
        ;; Target is stored in UCS
        (if (= 1 wview)
          (setq vtar (trans vtar 1 0))
        )
        (set_tile ;|MSG0|;"vtar_x" (rtos (car vtar)))
        (set_tile ;|MSG0|;"vtar_y" (rtos (cadr vtar)))
        (set_tile ;|MSG0|;"vtar_z" (rtos (caddr vtar)))
      )
      (progn
        (set_tile "persp" "DES")
        (if (= 1 wview)
          (setq lab "Centro (SCU)")
          (setq lab "Centro (SCP)")
        )
        (set_tile ;|MSG0|;"cen_tar" lab)
        ;; Viewctr is stored UCS
        (setq vtar (getvar "viewctr"))
        (if (= 1 wview)
          (setq vtar (trans vtar 1 0))
        )
        (set_tile ;|MSG0|;"vtar_x" (rtos (car vtar)))
        (set_tile ;|MSG0|;"vtar_y" (rtos (cadr vtar)))
        (set_tile ;|MSG0|;"vtar_z" (rtos (caddr vtar)))
      )
    )
  )

  ;;
  ;; Description of view.
  ;;
  (defun describe ()
    ;;
    ;; Views can either be new or existing.  New views that are created
    ;; are based on the current display and current settings of a bunch
    ;; of system variables.  Existing views have their description stored
    ;; in the View symbol table referenced by a number of group codes.
    ;; If perspective is on, a Target point is described and if perspective
    ;; is off a Center point is described.  If Worldview is on (1), the
    ;; direction and Center/Target points are described in WCS rather than
    ;; UCS.
    ;;
    ;;                     Center           Target          Direction
    ;; New Views
    ;; Perspective ON        -            target (UCS)      viewdir (UCS)
    ;; Perspective OFF    viewctr (UCS)       -             viewdir (UCS)
    ;;
    ;; Named Views
    ;; Perspective ON        -             12 Group (WCS)    11 Group (UCS)
    ;; Perspective OFF    10 group (DCS)      -              11 Group (UCS)
    ;;
    ;;

    (setq wview (getvar "worldview"))
    (setq viewname (nth (atoi picked_no) vnlist))
        (if (not (new_dialog ;|MSG0|;"vinquiry" dcl_id)) (exit))

        (set_tile ;|MSG0|;"v_name" viewname)

        (if (= 1 wview)
          (setq lab "Direcci≤n (SCU)")
          (setq lab "Direcci≤n (SCP)")
        )
        (set_tile ;|MSG0|;"direction" lab)

        (if (or (assoc viewname new_names)
                (= "*ACTUAL*" viewname)
            )
          (new_others)
          (named_others)
        )

        (action_tile ;|MSG0|;"accept" "(done_dialog 1)")
        (start_dialog)
  )
  ;;
  ;; Get information for description of existing views.
  ;;
  (defun named_others()
    (setq vt (tblsearch ;|MSG0|;"view" viewname))
    (set_tile ;|MSG0|;"v_height" (rtos (cdr (assoc 40 vt))))
    (set_tile ;|MSG0|;"v_width" (rtos (cdr (assoc 41 vt))))
    (set_tile ;|MSG0|;"v_twist" (angtos (cdr (assoc 50 vt))))
    (set_tile ;|MSG0|;"lens" (rtos (cdr (assoc 42 vt))))
    (set_tile ;|MSG0|;"fclip" (rtos (cdr (assoc 43 vt))))
    (set_tile ;|MSG0|;"bclip" (rtos (cdr (assoc 44 vt))))
    (setq vdir (cdr (assoc 11 vt)))
    ;; Stored in UCS
    (if (= 1 wview)
      (setq vdir (trans vdir 1 0 T))
    )
    (set_tile ;|MSG0|;"vdir_x" (rtos (car vdir)))
    (set_tile ;|MSG0|;"vdir_y" (rtos (cadr vdir)))
    (set_tile ;|MSG0|;"vdir_z" (rtos (caddr vdir)))

    (setq vmode (cdr (assoc 71 vt)))
    (if (= (logand 1 vmode) 2)
      (set_tile "fclipon" "ACT")
      (set_tile "fclipon" "DES")
    )
    (if (= (logand 1 vmode) 4)
      (set_tile "bclipon" "ACT")
      (set_tile "bclipon" "DES")
    )
    (if (= (logand 1 vmode) 1)
      (progn
        (set_tile "persp" "ACT")
        (if (= 1 wview)
          (setq lab "Motivo (SCU)")
          (setq lab "Motivo (SCP)")
        )
        (set_tile ;|MSG0|;"cen_tar" lab)
        (setq vtar (cdr (assoc 12 vt)))
        ;; Stored in WCS
        (if (= 0 wview)
          (setq vtar (trans vtar 0 1))
        )
        (set_tile ;|MSG0|;"vtar_x" (rtos (car vtar)))
        (set_tile ;|MSG0|;"vtar_y" (rtos (cadr vtar)))
        (set_tile ;|MSG0|;"vtar_z" (rtos (caddr vtar)))
      )
      (progn
        (set_tile "persp" "DES")
        (if (= 1 wview)
          (setq lab "Centro (SCU)")
          (setq lab "Centro (SCP)")
        )
        (set_tile ;|MSG0|;"cen_tar" lab)
        (setq vtar (cdr (assoc 10 vt)))
        ;; Stored in DCS
        (if (= 1 wview)
          (setq vtar (trans vtar 2 0))
          (setq vtar (trans vtar 2 1))
        )
        (set_tile ;|MSG0|;"vtar_x" (rtos (car vtar)))
        (set_tile ;|MSG0|;"vtar_y" (rtos (cadr vtar)))
        (set_tile ;|MSG0|;"vtar_z" (rtos (caddr vtar)))
      )
    )
  )
  ;;
  ;; Set up a variable that will be used when checking to see if a
  ;; selected view can be restored or not.  This variable is set
  ;; once when the dialogue is called to minimise time wasted.
  ;;
  (defun what_space()
    (cond
      ;; If in pspace and there are no mspace viewports do not allow
      ;; a mspace viewport to be resored.
      ((and (= 0 (getvar "tilemode"))
            (= 1 (getvar "cvport"))
            (not (cdr (vports)))
       )
       (setq restorable ;|MSG0|;"no_mspace")
      )
      ;; If in mspace (either one), do not allow a pspace viewport to
      ;; be restored.
      ((or (= 1 (getvar "tilemode"))
           (and (= 0 (getvar "tilemode"))
                (/= 1 (getvar "cvport"))
           )
       )
       (setq restorable ;|MSG0|;"no_pspace")
      )
      (t (setq restorable nil))
    )
  )
  ;;
  ;;  This function checks the validity of a table item name.  If legitimate,
  ;;  the table item name is returned, nil otherwise.
  ;;
  (defun check_name (name)
    (cond
      ((not name)
        (set_tile "error" "No se permiten nombres de vista en blanco.")
        nil
      )
      ((= "" new_view_name)
        (set_tile "error" "No se permiten nombres de vista en blanco.")
        nil
      )
      ((not (snvalid name))
        (set_tile "error" "Nombre de vista no vßlido. ")
        nil
      )
      (t (set_tile ;|MSG0|;"error" "") name)
    )
  )
  ;;
  ;;  This function checks the validity of a table item name.  If legitimate,
  ;;  the table item name is returned, nil otherwise.
  ;;
  (defun check_name1 (name)
    (cond
      ((not (snvalid name))
        (set_tile "error" "Nombre de vista no vßlido. ")
        nil
      )
      (t (set_tile ;|MSG0|;"error" "") name)
    )
  )
  ;;
  ;; Adding a new view name.
  ;;
  (defun save_view()
    (setq new_view_name (xstrcase (ai_strtrim (get_tile ;|MSG0|;"new_view_name"))))
    (cond
      ((not (check_name new_view_name)) (mode_tile ;|MSG0|;"new_view_name" 2))
      ((and (= x1 x2)
            (= y1 y2)
       )
       (set_tile "error" "Las esquinas de la ventana deben ser diferentes.")
      )
      ((and (or (member new_view_name init_list)
                (assoc new_view_name new_names)
            )
          (not (member new_view_name delete_list))
           (no_redefine)       ; if T, the redefinition was cancelled.
      ))
      (t
        ;; If the new view to be defined already exists in the drawing
        ;; then the name must be added to the delete list, in case the
        ;; newly defined view is later deleted.
        (if (member new_view_name init_list)
          (progn
            (setq delete_list (cons new_view_name delete_list))
            (setq vnlist (append
                            (reverse (cdr (member
                                            new_view_name (reverse vnlist))))
                            (cdr (member new_view_name vnlist))
                         )
            )
            (setq lboxlist
                         (rm_item (what_pos new_view_name vnlist) lboxlist)
            )
          )
        )
        (if (assoc new_view_name new_names)
          ;; remove new view name from new name list.
          (progn
            (setq new_names
                  (append
                     (reverse (cdr (member
                                     (assoc new_view_name new_names)
                                     (reverse new_names)
                     )))
                     (cdr (member (assoc new_view_name new_names) new_names))
                  )
            )
            (setq list_no (- (length vnlist)
                             (length (member new_view_name vnlist))
            ))
            (setq vnlist (rm_item list_no vnlist))
            (setq lboxlist (rm_item list_no lboxlist))
          )
        )
        (if (= 1 which_save)
          (setq new_names (append (list (list new_view_name)) new_names))
          (setq new_names (append
                             (list (list new_view_name x1 y1 x2 y2))
                             new_names
                          )
          )

        )
        ;; Add *current* to the lists.
        (if (= 1 (getvar "cvport"))
          (setq viewtype "ESPACIOP")
          (setq viewtype "ESPACIOM")
        )
        (setq vnlist (append vnlist (list new_view_name)))
        (setq lboxlist
              (append lboxlist (list (strcat new_view_name "\t" viewtype)))
        )
        (if (>= (getvar "maxsort") (length vnlist))
          (progn
            (if vnlist (setq vnlist (acad_strlsort vnlist)))
            (if lboxlist (setq lboxlist (acad_strlsort lboxlist)))
          )
        )
        (done_dialog 1)
        (setq new_view_name nil)      ; set the name to nil for the next time.
      )
    )
  )
  ;;
  ;; Update View list.
  ;;
  (defun update_list()
    (start_list ;|MSG0|;"list_view")
    (mapcar 'add_list lboxlist)
    (end_list)
    (set_tile ;|MSG0|;"list_view" "0")
    (setq picked_no "0")
    (grey_des)
  )
  ;;
  ;; If the new name already exists, inquire to overwrite it.
  ;;
  (defun no_redefine()
    (if (not (new_dialog ;|MSG0|;"valert" dcl_id)) (exit))
    (action_tile ;|MSG0|;"accept" "(done_dialog 1)")
    (action_tile ;|MSG0|;"cancel" "(done_dialog 0)")
    (if (= 0 (start_dialog)) t)       ; return T on Cancel
  )
  ;;
  ;; Pass a number and a list and recieve the list back with that item missing.
  ;;
  (defun rm_item (value the_list)
    (setq temp_lisp_list '())
    (setq j 0)
    (foreach n the_list
      (if (/= value j)
        (setq temp_lisp_list (cons n temp_lisp_list))
      )
      (setq j (1+ j))
    )
    (setq temp_lisp_list (reverse temp_lisp_list))
  )
  ;;
  ;; Delete view from list.
  ;;
  (defun delete()
    (setq viewname (nth (atoi picked_no) vnlist))
    (if (= viewname restore_view)
      (progn
        (setq restore_view "*ACTUAL*")
        (set_tile ;|MSG0|;"res_text" restore_view)
      )
    )
        ;; When deleting an item that only exists on the new list then
        ;; don't add it to the delete list.  Only add items to the
        ;; delete list when they are not members of the new list and
        ;; they are not members of the delete list already.
        (if (assoc viewname new_names)
          ;; remove new view name for new name list.
          (setq new_names
                (append
                   (reverse (cdr (member
                                   (assoc viewname new_names)
                                   (reverse new_names)
                   )))
                   (cdr (member (assoc viewname new_names) new_names))
                )
          )
          ;; only add it if it is not a member already and it is not
          ;; a member of the new name list.
          (if (not (member viewname delete_list))
            (setq delete_list (cons viewname delete_list))
          )
        )
        (setq vnlist (rm_item (atoi picked_no) vnlist))
        (setq lboxlist (rm_item (atoi picked_no) lboxlist))
        (update_list)
  )
  ;;
  ;; Disable the Describe button for *CURRENT* and new views.
  ;;
  (defun grey_des()
    (setq viewname (nth (atoi picked_no) vnlist))
    (setq lboxname (nth (atoi picked_no) lboxlist))
    (if (= "*ACTUAL*" viewname)
      (mode_tile ;|MSG0|;"delete" 1)
      (mode_tile ;|MSG0|;"delete" 0)
    )
    (cond
      ((and (= ;|MSG0|;"no_mspace" restorable)
            (= "\tESPACIOM" (substr lboxname (- (strlen lboxname) 6)))
       )
        (mode_tile ;|MSG0|;"restore" 1)
      )
      ((and (= ;|MSG0|;"no_pspace" restorable)
            (= "\tESPACIOP" (substr lboxname (- (strlen lboxname) 6)))
       )
        (mode_tile ;|MSG0|;"restore" 1)
      )
      (t
         (mode_tile ;|MSG0|;"restore" 0)
      )
    )
  )
  ;;
  ;; Update text string to reflect current view to restore.
  ;;
  (defun restore ()
    (setq restore_view (nth (atoi picked_no) vnlist))
    (set_tile ;|MSG0|;"res_text" restore_view)
  )
  ;;
  ;;  Creates a list of views in the drawing.
  ;;
  (defun make-lists(/ vname vlist flag lbname)
    (setq vnlist nil lboxlist nil)
    (setq vlist (tblnext ;|MSG0|;"view" T))
    (while vlist
      (setq vname (cdr (assoc 2 vlist)))
      (setq flag (cdr (assoc 70 vlist)))
      (if (= 1 (logand flag 1))
          (setq viewtype "ESPACIOP")
          (setq viewtype "ESPACIOM")
      )
          (setq lbname (strcat vname "\t" viewtype))
          (setq vnlist (append vnlist (list vname)))
          (setq lboxlist (append lboxlist (list lbname)))
      (setq vlist (tblnext ;|MSG0|;"view"))
    )

    ;; Add *CURRENT* to the lists.
    (setq vnlist (append (list "*ACTUAL*") vnlist))
    (setq lboxlist (append (list "*ACTUAL*") lboxlist))

    (setq init_list vnlist)           ; needed for checking purposes.

    (if (>= (getvar "maxsort") (length vnlist))
      (progn
        (if vnlist (setq vnlist (acad_strlsort vnlist)))
        (if lboxlist (setq lboxlist (acad_strlsort lboxlist)))
      )
    )
  )
  ;;
  ;;  Brings up the nested dialogue for creating new views.
  ;;
  (defun new_view()
    (if (not (new_dialog ;|MSG0|;"new_view" dcl_id)) (exit))

    ;; Set up initial values.
    (if (not which_save)
      (progn
        (setq which_save 1)
      )
    )

    (mode_tile ;|MSG0|;"new_view_name" 2)     ; set focus to the edit box.

    (if (= 1 which_save)
      (set_tile ;|MSG0|;"r_current" "1")
      (set_tile ;|MSG0|;"r_window" "1")
    )

    (setq x1 (car x1y1))
    (setq y1 (cadr x1y1))
    (setq x2 (car x2y2))
    (setq y2 (cadr x2y2))

    (set_tile ;|MSG0|;"x1_text" (rtos x1))
    (set_tile ;|MSG0|;"y1_text" (rtos y1))
    (set_tile ;|MSG0|;"x2_text" (rtos x2))
    (set_tile ;|MSG0|;"y2_text" (rtos y2))

    (enable_rad which_save)

    (if new_view_name (set_tile ;|MSG0|;"new_view_name" new_view_name))

    ;; Set up actions.
    (action_tile ;|MSG0|;"r_current" "(enable_rad 1)(setq which_save 1)")
    (action_tile ;|MSG0|;"r_window" "(enable_rad 0)(setq which_save 0)")
    (action_tile ;|MSG0|;"window" "(done_dialog 3)")
    (action_tile ;|MSG0|;"save_view" "(save_view)")
    (action_tile ;|MSG0|;"new_view_name" "(check_name1 (setq new_view_name $value))")

    (setq what_next1 (start_dialog))
    (cond
      ((= 3 what_next1)
       (done_dialog 2)
      )
      ((= 1 what_next1)
       (update_list)
      )
      ((= 0 what_next1)
       (setq new_view_name nil)
      )
    )
  )
  ;;
  ;; Disable/Enable the controls when picking in the New View dialogue.
  ;;
  (defun enable_rad (value)
    (mode_tile ;|MSG0|;"window" value)
    (mode_tile ;|MSG0|;"fc" value)
    (mode_tile ;|MSG0|;"oc" value)
  )
  ;;
  ;; Put up the dialogue.
  ;;
  (defun ddview_main()

    (make-lists)                        ; Create the view lists.

    (what_space)

    (setq x1y1 (trans (getvar "vsmin") 1 2))
    (setq x2y2 (trans (getvar "vsmax") 1 2))

    (setq x1 (car x1y1))
    (setq y1 (cadr x1y1))
    (setq x2 (car x2y2))
    (setq y2 (cadr x2y2))


    (setq what_next 5)
    (setq what_next1 nil)
    (while (< 1 what_next)      ; Loop necessary for hiding
      (if (not (new_dialog ;|MSG0|;"view" dcl_id)) (exit))
      ;; Put them in the list box.
      (start_list ;|MSG0|;"list_view")
      (mapcar 'add_list lboxlist)
      (end_list)

      ;; Set up initial defaults.
      (setq picked_no "0")
      (set_tile ;|MSG0|;"list_view" "0")
      (set_tile ;|MSG0|;"res_text" (nth (atoi picked_no) vnlist))   ; *current*
      (mode_tile ;|MSG0|;"delete" 1)

      ;; Define action of widgets
      (action_tile ;|MSG0|;"restore" "(restore)")
      (action_tile ;|MSG0|;"save" "(st_save)")
      (action_tile ;|MSG0|;"window" "(st_window)")
      (action_tile ;|MSG0|;"delete" "(delete)")
      (action_tile ;|MSG0|;"list_view" "(setq picked_no $value)(grey_des)")
      (action_tile ;|MSG0|;"edit_view" "(vedit_act $value)")
      (action_tile ;|MSG0|;"help" "(help \"\" \"ddview\")")
      (action_tile ;|MSG0|;"describe" "(describe)")
      (action_tile ;|MSG0|;"new_view" "(new_view)")
      (cond
        ((= what_next1 3)
          (new_view)
          (if (/= 3 what_next1) (setq what_next (start_dialog)))
        )
        (t (setq what_next (start_dialog)))
      )
      (cond
        ((= 2 what_next)
          (initget 1)
          (setq x1y1 (getpoint "\nPrimera esquina: "))
          (initget 1)
          (setq x2y2 (getcorner x1y1 "\nEsquina opuesta: "))
        )
      )
    )
    (if (= 1 what_next)
      (progn
        (foreach n delete_list
          (command "_.VIEW" "_D" n)
        )
        (foreach n new_names
          (if (cdr n)
            (command "_.VIEW" "_W" (car n) (list (nth 1 n) (nth 2 n))
                                        (list (nth 3 n) (nth 4 n))
            )
            (command "_.VIEW" "_S" (car n))
          )
        )
        ;; Only restore the view if it is not *CURRENT* or nil.
        (if (not (or (not restore_view)
                     (= restore_view "*ACTUAL*")
            ))
          (command "_.VIEW" "_R" restore_view)
        )
      )
    )
  )

  ;; 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 ;|MSG0|;"ddview"))))  ; is .DCL file loaded?
     (t
        (ai_undo_push)
        (ddview_main)                          ; proceed!
        (ai_undo_pop)
     )
  )

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

;;;----------------------------------------------------------------------------
(princ "  DDVIEW cargada.  ")
(princ)