home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 5.img / SUPPORT2.LIB / DDVIEW.LSP < prev    next >
Encoding:
Text File  |  1992-09-09  |  23.7 KB  |  753 lines

  1. ;;;----------------------------------------------------------------------------
  2. ;;;
  3. ;;;   DDVIEW.LSP   ¬⌐Ñ╗ 0.6
  4. ;;;
  5. ;;;   ¬⌐┼v (C) 1991-1992  Autodesk ñ╜Ñq
  6. ;;;
  7. ;;;   Ñ╗│n┼ΘºK╢O¿╤▒z╢iªµÑ⌠ª≤Ñ╬│~╗▌¿D¬║½■¿⌐íB¡╫º∩ñ╬╡oªµ, ª²¼O░╚╜╨┐φ┤`ñU¡z
  8. ;;;   ¡∞½h :
  9. ;;;
  10. ;;;   1)  ñWªC¬║¬⌐┼v│qºi░╚╗▌ÑX▓{ªb¿Cñ@Ñ≈½■¿⌐∙╪íC
  11. ;;;   2)  ¼█├÷¬║╗í⌐·ñσÑ≤ñ]Ñ▓╢╖⌐·╕ⁿ¬⌐┼v│qºiñ╬Ñ╗╢╡│\Ñi│qºiíC
  12. ;;;
  13. ;;;   Ñ╗│n┼Θ╢╚┤ú¿╤º@¼░└│Ñ╬ñW¬║░╤ª╥, ª╙Ñ╝┴n⌐·⌐╬┴⌠ºtÑ⌠ª≤½O├╥; ╣∩⌐≤Ñ⌠ª≤»S«φ
  14. ;;;   Ñ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºtÑX¿π¬║½O├╥, ªbª╣ñ@╖ºñ⌐ÑHº_╗{íC
  15. ;;;
  16. ;;;
  17. ;;;----------------------------------------------------------------------------
  18. ;;;   DESCRIPTION
  19. ;;;
  20. ;;;   Dialogue interface to VIEW command.  Uses DDVIEW.DCL
  21. ;;;
  22. ;;;----------------------------------------------------------------------------
  23. ;;;----------------------------------------------------------------------------
  24. ;;;   Prefixes in command and keyword strings:
  25. ;;;      "."  specifies the built-in AutoCAD command in case it has been
  26. ;;;           redefined.
  27. ;;;      "_"  denotes an AutoCAD command or keyword in the native language
  28. ;;;           version, English.
  29. ;;;----------------------------------------------------------------------------
  30. ;;;
  31. ;;; ===========================================================================
  32. ;;; ===================== load-time error checking ============================
  33. ;;;
  34.  
  35.   (defun ai_abort (app msg)
  36.      (defun *error* (s)
  37.         (if old_error (setq *error* old_error))
  38.         (princ)
  39.      )
  40.      (if msg
  41.        (alert (strcat " └│Ñ╬╡{ªí┐∙╗~: "
  42.                       app
  43.                       " \n\n  "
  44.                       msg
  45.                       "  \n"
  46.               )
  47.        )
  48.      )
  49.      (exit)
  50.   )
  51.  
  52. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
  53. ;;; and then try to load it.
  54. ;;;
  55. ;;; If it can't be found or it can't be loaded, then abort the
  56. ;;; loading of this file immediately, preserving the (autoload)
  57. ;;; stub function.
  58.  
  59.   (cond
  60.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
  61.  
  62.      (  (not (findfile "ai_utils.lsp"))                     ; find it
  63.         (ai_abort "DDVIEW"
  64.                   (strcat "ºΣñú¿∞íuAI_UTILS.LSPív└╔«╫;"
  65.                           "\n  ╜╨└╦¼díusupportívÑ╪┐²íC")))
  66.  
  67.      (  (eq "failed" (load "ai_utils" "failed"))            ; load it
  68.         (ai_abort "DDVIEW" "╡L¬k╕ⁿñJíuAI_UTILS.LSPív└╔«╫"))
  69.   )
  70.  
  71.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
  72.       (ai_abort "DDVIEW" nil)         ; a Nil <msg> supresses
  73.   )                                    ; ai_abort's alert box dialog.
  74.  
  75. ;;; ==================== end load-time operations ===========================
  76.  
  77. ;;;
  78. ;;; DDVIEW code.
  79. ;;;
  80. (defun c:ddview ( /
  81.                 ai_abort        lboxlist          restore_view       vt
  82.                 appname         lboxname          rm_item            vtar
  83.                 check_name      list_no           s                  what_next
  84.                 dcl_id          make-lists        save_view          what_next1
  85.                 delete          name              temp_lisp_list     what_space
  86.                 delete_list     named_others      the_list           which_save
  87.                 describe        new_names         update_list        wid
  88.                 enable_rad      new_others        value              wview
  89.                 errmsg          new_view          vcen               x1y1
  90.                                 new_view_name     vdir               x2
  91.                 grey_des        no_redefine       viewname           x2y2
  92.                 hi              old_cmd           viewtype           y1
  93.                 init_list       old_error                            y2
  94.                 j               picked_no         vmode              undo_init
  95.                 lab             restorable
  96.                                 restore           vnlist
  97.          )
  98.   ;;
  99.   ;; Pass an item and a list and recieve a number showing it's position in
  100.   ;; the list, nil otherwise.  Item must be in the list, and the list must
  101.   ;; contain unique names. 0 if first item.
  102.   ;;
  103.   (defun what_pos (item the_list / pos)
  104.     (setq pos (- (length the_list)
  105.                  (length (member item the_list)))
  106.     )
  107.   )
  108.   ;;
  109.   ;; Get information for description of new (not existing yet) views.
  110.   ;;
  111.   (defun new_others()
  112.     (if (cdr (assoc viewname new_names))
  113.       (progn
  114.         (setq wid (abs (- x2 x1)))
  115.         (setq hi (abs (- y2 y1)))
  116.       )
  117.       (progn
  118.         (setq wid (/ (* (getvar "viewsize") (abs (- x2 x1)))
  119.                      (abs (- y2 y1))
  120.                   )
  121.         )
  122.         (setq hi (getvar "viewsize"))
  123.       )
  124.     )
  125.     (set_tile "v_height" (rtos hi))
  126.     (set_tile "v_width" (rtos wid))
  127.     (set_tile "v_twist" (angtos (getvar "viewtwist")))
  128.     (set_tile "lens" (rtos (getvar "lenslength")))
  129.     (set_tile "fclip" (rtos (getvar "frontz")))
  130.     (set_tile "bclip" (rtos (getvar "backz")))
  131.  
  132.     ;; Viewdir is stored in UCS (yeah UCS)
  133.     (setq vdir (getvar "viewdir"))
  134.     (if (= 1 wview)
  135.       (setq vdir (trans vdir 1 0 T))
  136.     )
  137.     (set_tile "vdir_x" (rtos (car vdir)))
  138.     (set_tile "vdir_y" (rtos (cadr vdir)))
  139.     (set_tile "vdir_z" (rtos (caddr vdir)))
  140.  
  141.     (setq vmode (getvar "viewmode"))
  142.     (if (= (logand 2 vmode) 2)
  143.       (set_tile "fclipon" "ON")
  144.       (set_tile "fclipon" "OFF")
  145.     )
  146.     (if (= (logand 4 vmode) 4)
  147.       (set_tile "bclipon" "ON")
  148.       (set_tile "bclipon" "OFF")
  149.     )
  150.     (if (= (logand 1 vmode) 1)
  151.       (progn
  152.         (set_tile "persp" "ON")
  153.         (if (= 1 wview)
  154.           (setq lab "Target (WCS)")
  155.           (setq lab "Target (UCS)")
  156.         )
  157.         (set_tile "cen_tar" lab)
  158.         (setq vtar (getvar "target"))
  159.         ;; Target is stored in UCS
  160.         (if (= 1 wview)
  161.           (setq vtar (trans vtar 1 0))
  162.         )
  163.         (set_tile "vtar_x" (rtos (car vtar)))
  164.         (set_tile "vtar_y" (rtos (cadr vtar)))
  165.         (set_tile "vtar_z" (rtos (caddr vtar)))
  166.       )
  167.       (progn
  168.         (set_tile "persp" "OFF")
  169.         (if (= 1 wview)
  170.           (setq lab "Center (WCS)")
  171.           (setq lab "Center (UCS)")
  172.         )
  173.         (set_tile "cen_tar" lab)
  174.         ;; Viewctr is stored UCS
  175.         (setq vtar (getvar "viewctr"))
  176.         (if (= 1 wview)
  177.           (setq vtar (trans vtar 1 0))
  178.         )
  179.         (set_tile "vtar_x" (rtos (car vtar)))
  180.         (set_tile "vtar_y" (rtos (cadr vtar)))
  181.         (set_tile "vtar_z" (rtos (caddr vtar)))
  182.       )
  183.     )
  184.   )
  185.  
  186.   ;;
  187.   ;; Description of view.
  188.   ;;
  189.   (defun describe ()
  190.     ;;
  191.     ;; Views can either be new or existing.  New views that are created
  192.     ;; are based on the current display and current settings of a bunch
  193.     ;; of system variables.  Existing views have their description stored
  194.     ;; in the View symbol table referenced by a number of group codes.
  195.     ;; If perspective is on, a Target point is described and if perspective
  196.     ;; is off a Center point is described.  If Worldview is on (1), the
  197.     ;; direction and Center/Target points are described in WCS rather than
  198.     ;; UCS.
  199.     ;;
  200.     ;;                     Center           Target          Direction
  201.     ;; New Views
  202.     ;; Perspective ON        -            target (UCS)      viewdir (UCS)
  203.     ;; Perspective OFF    viewctr (UCS)       -             viewdir (UCS)
  204.     ;;
  205.     ;; Named Views
  206.     ;; Perspective ON        -             12 Group (WCS)    11 Group (UCS)
  207.     ;; Perspective OFF    10 group (DCS)      -              11 Group (UCS)
  208.     ;;
  209.     ;;
  210.  
  211.     (setq wview (getvar "worldview"))
  212.     (setq viewname (nth (atoi picked_no) vnlist))
  213.         (if (not (new_dialog "vinquiry" dcl_id)) (exit))
  214.  
  215.         (set_tile "v_name" viewname)
  216.  
  217.         (if (= 1 wview)
  218.           (setq lab "Direction (WCS)")
  219.           (setq lab "Direction (UCS)")
  220.         )
  221.         (set_tile "direction" lab)
  222.  
  223.         (if (or (assoc viewname new_names)
  224.                 (= "* Ñ╪½e *" viewname)
  225.             )
  226.           (new_others)
  227.           (named_others)
  228.         )
  229.  
  230.         (action_tile "accept" "(done_dialog 1)")
  231.         (start_dialog)
  232.   )
  233.   ;;
  234.   ;; Get information for description of existing views.
  235.   ;;
  236.   (defun named_others()
  237.     (setq vt (tblsearch "view" viewname))
  238.     (set_tile "v_height" (rtos (cdr (assoc 40 vt))))
  239.     (set_tile "v_width" (rtos (cdr (assoc 41 vt))))
  240.     (set_tile "v_twist" (angtos (cdr (assoc 50 vt))))
  241.     (set_tile "lens" (rtos (cdr (assoc 42 vt))))
  242.     (set_tile "fclip" (rtos (cdr (assoc 43 vt))))
  243.     (set_tile "bclip" (rtos (cdr (assoc 44 vt))))
  244.     (setq vdir (cdr (assoc 11 vt)))
  245.     ;; Stored in UCS
  246.     (if (= 1 wview)
  247.       (setq vdir (trans vdir 1 0 T))
  248.     )
  249.     (set_tile "vdir_x" (rtos (car vdir)))
  250.     (set_tile "vdir_y" (rtos (cadr vdir)))
  251.     (set_tile "vdir_z" (rtos (caddr vdir)))
  252.  
  253.     (setq vmode (cdr (assoc 71 vt)))
  254.     (if (= (logand 1 vmode) 2)
  255.       (set_tile "fclipon" "ON")
  256.       (set_tile "fclipon" "OFF")
  257.     )
  258.     (if (= (logand 1 vmode) 4)
  259.       (set_tile "bclipon" "ON")
  260.       (set_tile "bclipon" "OFF")
  261.     )
  262.     (if (= (logand 1 vmode) 1)
  263.       (progn
  264.         (set_tile "persp" "ON")
  265.         (if (= 1 wview)
  266.           (setq lab "Target (WCS)")
  267.           (setq lab "Target (UCS)")
  268.         )
  269.         (set_tile "cen_tar" lab)
  270.         (setq vtar (cdr (assoc 12 vt)))
  271.         ;; Stored in WCS
  272.         (if (= 0 wview)
  273.           (setq vtar (trans vtar 0 1))
  274.         )
  275.         (set_tile "vtar_x" (rtos (car vtar)))
  276.         (set_tile "vtar_y" (rtos (cadr vtar)))
  277.         (set_tile "vtar_z" (rtos (caddr vtar)))
  278.       )
  279.       (progn
  280.         (set_tile "persp" "OFF")
  281.         (if (= 1 wview)
  282.           (setq lab "Center (WCS)")
  283.           (setq lab "Center (UCS)")
  284.         )
  285.         (set_tile "cen_tar" lab)
  286.         (setq vtar (cdr (assoc 10 vt)))
  287.         ;; Stored in DCS
  288.         (if (= 1 wview)
  289.           (setq vtar (trans vtar 2 0))
  290.           (setq vtar (trans vtar 2 1))
  291.         )
  292.         (set_tile "vtar_x" (rtos (car vtar)))
  293.         (set_tile "vtar_y" (rtos (cadr vtar)))
  294.         (set_tile "vtar_z" (rtos (caddr vtar)))
  295.       )
  296.     )
  297.   )
  298.   ;;
  299.   ;; Set up a variable that will be used when checking to see if a
  300.   ;; selected view can be restored or not.  This variable is set
  301.   ;; once when the dialogue is called to minimise time wasted.
  302.   ;;
  303.   (defun what_space()
  304.     (cond
  305.       ;; If in pspace and there are no mspace viewports do not allow
  306.       ;; a mspace viewport to be resored.
  307.       ((and (= 0 (getvar "tilemode"))
  308.             (= 1 (getvar "cvport"))
  309.             (not (cdr (vports)))
  310.        )
  311.        (setq restorable "no_mspace")
  312.       )
  313.       ;; If in mspace (either one), do not allow a pspace viewport to
  314.       ;; be restored.
  315.       ((or (= 1 (getvar "tilemode"))
  316.            (and (= 0 (getvar "tilemode"))
  317.                 (/= 1 (getvar "cvport"))
  318.            )
  319.        )
  320.        (setq restorable "no_pspace")
  321.       )
  322.       (t (setq restorable nil))
  323.     )
  324.   )
  325.   ;;
  326.   ;;  This function checks the validity of a table item name.  If legitimate,
  327.   ;;  the table item name is returned, nil otherwise.
  328.   ;;
  329.   (defun check_name (name)
  330.     (cond
  331.       ((not name)
  332.         (set_tile "error" "╡L«─ í╨ ñú▒╡¿ⁿíuNull ╡°┤║ªW║┘ívíC")
  333.         nil
  334.       )
  335.       ((= "" new_view_name)
  336.         (set_tile "error" "╡L«─ í╨ ñú▒╡¿ⁿíuNull ╡°┤║ªW║┘ívíC")
  337.         nil
  338.       )
  339.       ((wcmatch name "*[] `#`@`.`?`*`~`[`,`'!%^&()+={}|`\\:;\"<>/]*")
  340.         (set_tile "error" "íu╡°┤║ªW║┘ívññºtª│íu╡L«─ªrñ╕ívíC")
  341.         nil
  342.       )
  343.       ((< 31 (strlen new_view_name))
  344.         (set_tile "error" "íu╡°┤║ªW║┘ív╢WÑX 31 ¡╙ªrñ╕ñW¡¡íC")
  345.         nil
  346.       )
  347.       (t (set_tile "error" "") name)
  348.     )
  349.   )
  350.   ;;
  351.   ;;  This function checks the validity of a table item name.  If legitimate,
  352.   ;;  the table item name is returned, nil otherwise.
  353.   ;;
  354.   (defun check_name1 (name)
  355.     (cond
  356.       ((wcmatch name "*[] `#`@`.`?`*`~`[`,`'!%^&()+={}|`\\:;\"<>/]*")
  357.         (set_tile "error" "íu╡°┤║ªW║┘ívññºtª│íu╡L«─ªrñ╕ívíC")
  358.         nil
  359.       )
  360.       ((< 31 (strlen new_view_name))
  361.         (set_tile "error" "íu╡°┤║ªW║┘ív╢WÑX 31 ¡╙ªrñ╕ñW¡¡íC")
  362.         nil
  363.       )
  364.       (t (set_tile "error" "") name)
  365.     )
  366.   )
  367.   ;;
  368.   ;; Adding a new view name.
  369.   ;;
  370.   (defun save_view()
  371.     (setq new_view_name (strcase (ai_strtrim (get_tile "new_view_name"))))
  372.     (cond
  373.       ((not (check_name new_view_name)) (mode_tile "new_view_name" 2))
  374.       ((and (= x1 x2)
  375.             (= y1 y2)
  376.        )
  377.        (set_tile "error" "╡L«─ í╨ ╡°╡ííu¿ñ┬IívñúÑiª@┬IíC")
  378.       )
  379.       ((and (or (member new_view_name init_list)
  380.                 (assoc new_view_name new_names)
  381.             )
  382.           (not (member new_view_name delete_list))
  383.            (no_redefine)       ; if T, the redefinition was cancelled.
  384.       ))
  385.       (t
  386.         ;; If the new view to be defined already exists in the drawing
  387.         ;; then the name must be added to the delete list, in case the
  388.         ;; newly defined view is later deleted.
  389.         (if (member new_view_name init_list)
  390.           (progn
  391.             (setq delete_list (cons new_view_name delete_list))
  392.             (setq vnlist (append
  393.                             (reverse (cdr (member
  394.                                             new_view_name (reverse vnlist))))
  395.                             (cdr (member new_view_name vnlist))
  396.                          )
  397.             )
  398.             (setq lboxlist
  399.                          (rm_item (what_pos new_view_name vnlist) lboxlist)
  400.             )
  401.           )
  402.         )
  403.         (if (assoc new_view_name new_names)
  404.           ;; remove new view name from new name list.
  405.           (progn
  406.             (setq new_names
  407.                   (append
  408.                      (reverse (cdr (member
  409.                                      (assoc new_view_name new_names)
  410.                                      (reverse new_names)
  411.                      )))
  412.                      (cdr (member (assoc new_view_name new_names) new_names))
  413.                   )
  414.             )
  415.             (setq list_no (- (length vnlist)
  416.                              (length (member new_view_name vnlist))
  417.             ))
  418.             (setq vnlist (rm_item list_no vnlist))
  419.             (setq lboxlist (rm_item list_no lboxlist))
  420.           )
  421.         )
  422.         (if (= 1 which_save)
  423.           (setq new_names (append (list (list new_view_name)) new_names))
  424.           (setq new_names (append
  425.                              (list (list new_view_name x1 y1 x2 y2))
  426.                              new_names
  427.                           )
  428.           )
  429.  
  430.         )
  431.         ;; Add *current* to the lists.
  432.         (if (= 1 (getvar "cvport"))
  433.           (setq viewtype "PSPACE")
  434.           (setq viewtype "MSPACE")
  435.         )
  436.         (setq vnlist (append vnlist (list new_view_name)))
  437.         (setq lboxlist
  438.               (append lboxlist (list (strcat new_view_name "\t" viewtype)))
  439.         )
  440.         (if (>= (getvar "maxsort") (length vnlist))
  441.           (progn
  442.             (if vnlist (setq vnlist (acad_strlsort vnlist)))
  443.             (if lboxlist (setq lboxlist (acad_strlsort lboxlist)))
  444.           )
  445.         )
  446.         (done_dialog 1)
  447.         (setq new_view_name nil)      ; set the name to nil for the next time.
  448.       )
  449.     )
  450.   )
  451.   ;;
  452.   ;; Update View list.
  453.   ;;
  454.   (defun update_list()
  455.     (start_list "list_view")
  456.     (mapcar 'add_list lboxlist)
  457.     (end_list)
  458.     (set_tile "list_view" "0")
  459.     (setq picked_no "0")
  460.     (grey_des)
  461.   )
  462.   ;;
  463.   ;; If the new name already exists, inquire to overwrite it.
  464.   ;;
  465.   (defun no_redefine()
  466.     (if (not (new_dialog "valert" dcl_id)) (exit))
  467.     (action_tile "accept" "(done_dialog 1)")
  468.     (action_tile "cancel" "(done_dialog 0)")
  469.     (if (= 0 (start_dialog)) t)       ; return T on Cancel
  470.   )
  471.   ;;
  472.   ;; Pass a number and a list and recieve the list back with that item missing.
  473.   ;;
  474.   (defun rm_item (value the_list)
  475.     (setq temp_lisp_list '())
  476.     (setq j 0)
  477.     (foreach n the_list
  478.       (if (/= value j)
  479.         (setq temp_lisp_list (cons n temp_lisp_list))
  480.       )
  481.       (setq j (1+ j))
  482.     )
  483.     (setq temp_lisp_list (reverse temp_lisp_list))
  484.   )
  485.   ;;
  486.   ;; Delete view from list.
  487.   ;;
  488.   (defun delete()
  489.     (setq viewname (nth (atoi picked_no) vnlist))
  490.     (if (= viewname restore_view)
  491.       (progn
  492.         (setq restore_view "* Ñ╪½e *")
  493.         (set_tile "res_text" restore_view)
  494.       )
  495.     )
  496.         ;; When deleting an item that only exists on the new list then
  497.         ;; don't add it to the delete list.  Only add items to the
  498.         ;; delete list when they are not members of the new list and
  499.         ;; they are not members of the delete list already.
  500.         (if (assoc viewname new_names)
  501.           ;; remove new view name for new name list.
  502.           (setq new_names
  503.                 (append
  504.                    (reverse (cdr (member
  505.                                    (assoc viewname new_names)
  506.                                    (reverse new_names)
  507.                    )))
  508.                    (cdr (member (assoc viewname new_names) new_names))
  509.                 )
  510.           )
  511.           ;; only add it if it is not a member already and it is not
  512.           ;; a member of the new name list.
  513.           (if (not (member viewname delete_list))
  514.             (setq delete_list (cons viewname delete_list))
  515.           )
  516.         )
  517.         (setq vnlist (rm_item (atoi picked_no) vnlist))
  518.         (setq lboxlist (rm_item (atoi picked_no) lboxlist))
  519.         (update_list)
  520.   )
  521.   ;;
  522.   ;; Disable the Describe button for *CURRENT* and new views.
  523.   ;;
  524.   (defun grey_des()
  525.     (setq viewname (nth (atoi picked_no) vnlist))
  526.     (setq lboxname (nth (atoi picked_no) lboxlist))
  527.     (if (= "* Ñ╪½e *" viewname)
  528.       (mode_tile "delete" 1)
  529.       (mode_tile "delete" 0)
  530.     )
  531.     (cond
  532.       ((and (= "no_mspace" restorable)
  533.             (= "\tMSPACE" (substr lboxname (- (strlen lboxname) 6)))
  534.        )
  535.         (mode_tile "restore" 1)
  536.       )
  537.       ((and (= "no_pspace" restorable)
  538.             (= "\tPSPACE" (substr lboxname (- (strlen lboxname) 6)))
  539.        )
  540.         (mode_tile "restore" 1)
  541.       )
  542.       (t
  543.          (mode_tile "restore" 0)
  544.       )
  545.     )
  546.   )
  547.   ;;
  548.   ;; Update text string to reflect current view to restore.
  549.   ;;
  550.   (defun restore ()
  551.     (setq restore_view (nth (atoi picked_no) vnlist))
  552.     (set_tile "res_text" restore_view)
  553.   )
  554.   ;;
  555.   ;;  Creates a list of views in the drawing.
  556.   ;;
  557.   (defun make-lists(/ vname vlist flag lbname)
  558.     (setq vnlist nil lboxlist nil)
  559.     (setq vlist (tblnext "view" T))
  560.     (while vlist
  561.       (setq vname (cdr (assoc 2 vlist)))
  562.       (setq flag (cdr (assoc 70 vlist)))
  563.       (if (= 1 (logand flag 1))
  564.           (setq viewtype "PSPACE")
  565.           (setq viewtype "MSPACE")
  566.       )
  567.           (setq lbname (strcat vname "\t" viewtype))
  568.           (setq vnlist (append vnlist (list vname)))
  569.           (setq lboxlist (append lboxlist (list lbname)))
  570.       (setq vlist (tblnext "view"))
  571.     )
  572.  
  573.     ;; Add *CURRENT* to the lists.
  574.     (setq vnlist (append (list "* Ñ╪½e *") vnlist))
  575.     (setq lboxlist (append (list "* Ñ╪½e *") lboxlist))
  576.  
  577.     (setq init_list vnlist)           ; needed for checking purposes.
  578.  
  579.     (if (>= (getvar "maxsort") (length vnlist))
  580.       (progn
  581.         (if vnlist (setq vnlist (acad_strlsort vnlist)))
  582.         (if lboxlist (setq lboxlist (acad_strlsort lboxlist)))
  583.       )
  584.     )
  585.   )
  586.   ;;
  587.   ;;  Brings up the nested dialogue for creating new views.
  588.   ;;
  589.   (defun new_view()
  590.     (if (not (new_dialog "new_view" dcl_id)) (exit))
  591.  
  592.     ;; Set up initial values.
  593.     (if (not which_save)
  594.       (progn
  595.         (setq which_save 1)
  596.       )
  597.     )
  598.  
  599.     (mode_tile "new_view_name" 2)     ; set focus to the edit box.
  600.  
  601.     (if (= 1 which_save)
  602.       (set_tile "r_current" "1")
  603.       (set_tile "r_window" "1")
  604.     )
  605.  
  606.     (setq x1 (car x1y1))
  607.     (setq y1 (cadr x1y1))
  608.     (setq x2 (car x2y2))
  609.     (setq y2 (cadr x2y2))
  610.  
  611.     (set_tile "x1_text" (rtos x1))
  612.     (set_tile "y1_text" (rtos y1))
  613.     (set_tile "x2_text" (rtos x2))
  614.     (set_tile "y2_text" (rtos y2))
  615.  
  616.     (enable_rad which_save)
  617.  
  618.     (if new_view_name (set_tile "new_view_name" new_view_name))
  619.  
  620.     ;; Set up actions.
  621.     (action_tile "r_current" "(enable_rad 1)(setq which_save 1)")
  622.     (action_tile "r_window" "(enable_rad 0)(setq which_save 0)")
  623.     (action_tile "window" "(done_dialog 3)")
  624.     (action_tile "save_view" "(save_view)")
  625.     (action_tile "new_view_name" "(check_name1 (setq new_view_name $value))")
  626.  
  627.     (setq what_next1 (start_dialog))
  628.     (cond
  629.       ((= 3 what_next1)
  630.        (done_dialog 2)
  631.       )
  632.       ((= 1 what_next1)
  633.        (update_list)
  634.       )
  635.     )
  636.   )
  637.   ;;
  638.   ;; Disable/Enable the controls when picking in the New View dialogue.
  639.   ;;
  640.   (defun enable_rad (value)
  641.     (mode_tile "window" value)
  642.     (mode_tile "fc" value)
  643.     (mode_tile "oc" value)
  644.   )
  645.   ;;
  646.   ;; Put up the dialogue.
  647.   ;;
  648.   (defun ddview_main()
  649.  
  650.     (make-lists)                        ; Create the view lists.
  651.  
  652.     (what_space)
  653.  
  654.     (setq x1y1 (getvar "vsmin"))
  655.     (setq x2y2 (getvar "vsmax"))
  656.  
  657.     (setq x1 (car x1y1))
  658.     (setq y1 (cadr x1y1))
  659.     (setq x2 (car x2y2))
  660.     (setq y2 (cadr x2y2))
  661.  
  662.  
  663.     (setq what_next 5)
  664.     (setq what_next1 nil)
  665.     (while (< 1 what_next)      ; Loop necessary for hiding
  666.       (if (not (new_dialog "view" dcl_id)) (exit))
  667.       ;; Put them in the list box.
  668.       (start_list "list_view")
  669.       (mapcar 'add_list lboxlist)
  670.       (end_list)
  671.  
  672.       ;; Set up initial defaults.
  673.       (setq picked_no "0")
  674.       (set_tile "list_view" "0")
  675.       (set_tile "res_text" (nth (atoi picked_no) vnlist))   ; *current*
  676.       (mode_tile "delete" 1)
  677.  
  678.       ;; Define action of widgets
  679.       (action_tile "restore" "(restore)")
  680.       (action_tile "save" "(st_save)")
  681.       (action_tile "window" "(st_window)")
  682.       (action_tile "delete" "(delete)")
  683.       (action_tile "list_view" "(setq picked_no $value)(grey_des)")
  684.       (action_tile "edit_view" "(vedit_act $value)")
  685.       (action_tile "help" "(acad_helpdlg \"acad.hlp\" \"ddview\")")
  686.       (action_tile "describe" "(describe)")
  687.       (action_tile "new_view" "(new_view)")
  688.       (cond
  689.         ((= what_next1 3)
  690.           (new_view)
  691.           (if (/= 3 what_next1) (setq what_next (start_dialog)))
  692.         )
  693.         (t (setq what_next (start_dialog)))
  694.       )
  695.       (cond
  696.         ((= 2 what_next)
  697.           (setq x1y1 (getpoint "\n▓─ 1 ¿ñ┬I: "))
  698.           (setq x2y2 (getcorner x1y1 "\n╣∩¿ñ┬I: "))
  699.         )
  700.       )
  701.     )
  702.     (if (= 1 what_next)
  703.       (progn
  704.         (foreach n delete_list
  705.           (command "_.VIEW" "_D" n)
  706.         )
  707.         (foreach n new_names
  708.           (if (cdr n)
  709.             (command "_.VIEW" "_W" (car n) (list (nth 1 n) (nth 2 n))
  710.                                         (list (nth 3 n) (nth 4 n))
  711.             )
  712.             (command "_.VIEW" "_S" (car n))
  713.           )
  714.         )
  715.         ;; Only restore the view if it is not *CURRENT* or nil.
  716.         (if (not (or (not restore_view)
  717.                      (= restore_view "* Ñ╪½e *")
  718.             ))
  719.           (command "_.VIEW" "_R" restore_view)
  720.         )
  721.       )
  722.     )
  723.   )
  724.  
  725.   ;; Set up error function.
  726.   (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
  727.         old_error  *error*            ; save current error function
  728.         *error* ai_error              ; new error function
  729.   )
  730.  
  731.   (setvar "cmdecho" 0)
  732.  
  733.   (cond
  734.      (  (not (ai_notrans)))                       ; transparent not OK
  735.      (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
  736.      (  (not (setq dcl_id (ai_dcl "ddview"))))  ; is .DCL file loaded?
  737.      (t
  738.         (ai_undo_push)
  739.         (ddview_main)                          ; proceed!
  740.         (ai_undo_pop)
  741.      )
  742.   )
  743.  
  744.   (setq *error* old_error)
  745.   (setvar "cmdecho" old_cmd)
  746.   (princ)
  747. )
  748.  
  749. ;;;----------------------------------------------------------------------------
  750. (princ "  íuDDVIEWívñw╕ⁿñJíC")
  751. (princ)
  752.  
  753.