home *** CD-ROM | disk | FTP | other *** search
/ Windows 95 v2.4 Fix / W95-v2.4fix.iso / ACADWIN / SUPPORT / DDUNITS.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1995-02-08  |  20.7 KB  |  639 lines
  1. ; Next available MSG number is    13 
  2. ; MODULE_ID DDUNITS_LSP_
  3. ;;;
  4. ;;;    ddunits.lsp
  5. ;;;
  6. ;;;    Copyright (C) 1992, 1994 by Autodesk, Inc.
  7. ;;;
  8. ;;;    Permission to use, copy, modify, and distribute this software
  9. ;;;    for any purpose and without fee is hereby granted, provided
  10. ;;;    that the above copyright notice appears in all copies and
  11. ;;;    that both that copyright notice and the limited warranty and
  12. ;;;    restricted rights notice below appear in all supporting
  13. ;;;    documentation.
  14. ;;;
  15. ;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
  16. ;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
  17. ;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
  18. ;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
  19. ;;;    UNINTERRUPTED OR ERROR FREE.
  20. ;;;
  21. ;;;    Use, duplication, or disclosure by the U.S. Government is subject to
  22. ;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
  23. ;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii) 
  24. ;;;    (Rights in Technical Data and Computer Software), as applicable.
  25. ;;;
  26. ;;;.
  27. ;;;    DESCRIPTION
  28. ;;;    
  29. ;;;    DDUNITS.LSP is designed to provide a quick and easy interface to the 
  30. ;;;    existing AutoCAD UNITS command. DDUNITS.LSP utilizes DDUNITS.DCL to 
  31. ;;;    provide a layout for the DDUNITS dialogue box.
  32. ;;;
  33. ;;;    The routine affects the following system variables:
  34. ;;;
  35. ;;;       LUNITS, LUPREC, AUNITS, AUPREC, ANGBASE, and ANGDIR.
  36. ;;;
  37. ;;;--------------------------------------------------------------------
  38. ;;;    OPERATION
  39. ;;;
  40. ;;;    After loading the routine, it is started by typing DDUNITS. This will
  41. ;;;    load up the Proteus Dialogue interface. The current settings are
  42. ;;;    displayed in the dialogue. 
  43. ;;;
  44. ;;;    Any or all aspects of the units command can be changed and the new 
  45. ;;;    value will take affect when the OK button is pressed. The Units
  46. ;;;    modes are selected by selecting the appropriate radio buttons. Each 
  47. ;;;    time a setting is chosen an example is shown in a popup list, which
  48. ;;;    also is used to change the precision of the units. To choose the
  49. ;;;    angle direction (ANGDIR), press the "Direction..." button. Another
  50. ;;;    dialogue appears; standard choices are listed in a radio cluster and
  51. ;;;    an option for "Other" is given to allow for a screen picked angle or
  52. ;;;    a keyed in angle.
  53. ;;;
  54. ;;;    Choosing the OK button accepts the currently displayed settings and
  55. ;;;    sets the appropriate system variables. Choosing the CANCEL button
  56. ;;;    will abort the dialogue and leave the system "as-is." A Help button
  57. ;;;    is available to display the AutoCAD help information on the units
  58. ;;;    command.
  59. ;;;----------------------------------------------------------------------
  60. ;;;
  61. ;;;==================== load-time error checking ========================
  62.  
  63.   (defun ai_abort (app msg)
  64.      (defun *error* (s)
  65.         (if old_error (setq *error* old_error))
  66.         (princ)
  67.      )
  68.      (if msg
  69.        (alert (strcat " Error en la aplicaci≤n: "
  70.                       app
  71.                       " \n\n  "
  72.                       msg
  73.                       "  \n"
  74.               )
  75.        )
  76.      )
  77.      (exit)
  78.   )
  79.  
  80. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
  81. ;;; and then try to load it.
  82. ;;;
  83. ;;; If it can't be found or it can't be loaded, then abort the
  84. ;;; loading of this file immediately, preserving the (autoload)
  85. ;;; stub function.
  86.  
  87.   (cond
  88.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
  89.  
  90.      (  (not (findfile ;|MSG0|;"ai_utils.lsp"))                     ; find it
  91.         (ai_abort "DDUNITS"
  92.                   (strcat "Imposible localizar el archivo AI_UTILS.LSP."
  93.                           "\n Compruebe el directorio de soporte.")))
  94.  
  95.      (  (eq ;|MSG0|;"failed" (load "ai_utils" ;|MSG0|;"failed"))            ; load it
  96.         (ai_abort "DDUNITS" "Imposible cargar el archivo AI_UTILS.LSP"))
  97.   )
  98.  
  99.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
  100.       (ai_abort "DDUNITS" nil)         ; a Nil <msg> supresses
  101.   )                                    ; ai_abort's alert box dialog.
  102.  
  103. ;;;==================== end load-time operations ========================
  104.  
  105. (defun c:ddunits (/
  106.                    abase      auprec     luprec       ulist
  107.                    alist                 old_cmd      what_next
  108.                    angbase    dcl_id     old_error    what_next1
  109.                    angdir     f_done     other        fix_auprec 
  110.                    aunits     lunits     tmp_base     undo_init
  111.                    temp_angdir  temp_abase
  112.                  )
  113.   ;;
  114.   ;; CHECK_INPUT  - checks input (angle zero direction edit box)
  115.   ;;           called when OK is pressed in Direction child dialog.
  116.   (defun check_input ()
  117.     (if (= 1 (atoi (get_tile ;|MSG0|;"other")))
  118.       (if (not (setq tmp_base (angtof (get_tile ;|MSG0|;"angle_edit") aunits)))
  119.         (progn
  120.           (set_tile "error" "Angulo no vßlido")
  121.           (mode_tile ;|MSG0|;"angle_edit" 2)
  122.         )
  123.         (progn
  124.           (if (= temp_angdir 1)
  125.             (cond 
  126.              ((> 0 (- tmp_base angbase))
  127.               (setq abase (+ (* 2 pi) (- tmp_base angbase)))
  128.              )
  129.              ((< (* 2 pi) (- tmp_base angbase))
  130.               (setq abase (- (- tmp_base angbase) (* 2 pi)))
  131.              )
  132.              (t (setq abase (- tmp_base angbase)))
  133.             )
  134.           )
  135.           (setq angdir temp_angdir)
  136.           (done_dialog 1)
  137.         )
  138.       )
  139.       (progn
  140.         (setq abase temp_abase)
  141.         (setq angdir temp_angdir)
  142.         (done_dialog 1)
  143.       )
  144.     )
  145.   )
  146.   ;;
  147.   ;; S_UNIT - sets the system variables - called when OK is pressed.
  148.   ;;
  149.   (defun s_unit ()
  150.     (setvar "ANGDIR" angdir)
  151.     (if (/= abase angbase)
  152.       (setvar "ANGBASE" abase)
  153.     )
  154.     (setvar "AUNITS" aunits)
  155.     (setvar "AUPREC" auprec)
  156.     (setvar "LUNITS" lunits)
  157.     (setvar "LUPREC" luprec)
  158.   )
  159.   ;;
  160.   ;; GRAB_ANGLE - action function for the Direction/Angle edit box.
  161.   ;;
  162.   (defun grab_angle()
  163.     (set_tile ;|MSG0|;"error" "")
  164.     (if (not (setq tmp_base (angtof (get_tile ;|MSG0|;"angle_edit") aunits)))
  165.       (set_tile "error" "Angulo no vßlido")
  166.       (progn
  167.         (setq temp_abase (- tmp_base angbase))
  168.         (set_tile ;|MSG0|;"angle_edit" (angtos tmp_base aunits auprec))
  169.       )
  170.     )
  171.   )
  172.   ;;
  173.   ;; SET_ULIST - Sets Units/Precision popup list.
  174.   ;;
  175.   (defun set_ulist ()
  176.     (cond
  177.       ((= lunits 1) ; scientific
  178.         (setq ulist (list "0E+01" "0.0E+01" "0.00E+01" "0.000E+01"
  179.                        "0.0000E+01" "0.00000E+01" "0.000000E+01"
  180.                        "0.0000000E+01" "0.00000000E+01") )
  181.       )
  182.       ((= lunits 2) ; decimal
  183.         (setq ulist (list "0" "0.0" "0.00" "0.000" "0.0000" "0.00000"
  184.                        "0.000000" "0.0000000" "0.00000000") )
  185.       )
  186.       ((= lunits 3) ; engineering
  187.         (if (= (getvar "unitmode") 1)
  188.           (setq ulist (list "0'0\"" "0'0.0\"" "0'0.00\"" "0'0.000\""
  189.                        "0'0.0000\"" "0'0.00000\"" "0'0.000000\""
  190.                        "0'0.0000000\"" "0'0.00000000\"") )
  191.           (setq ulist (list "0'-0\"" "0'-0.0\"" "0'-0.00\"" "0'-0.000\""
  192.                        "0'-0.0000\"" "0'-0.00000\"" "0'-0.000000\""
  193.                        "0'-0.0000000\"" "0'-0.00000000\"") )
  194.         )
  195.       )
  196.       ((= lunits 4) ; architectural
  197.         (if (= (getvar "unitmode") 1)
  198.           (setq ulist (list "0'0\"" "0'0-1/2\"" "0'0-1/4\"" "0'0-1/8\""
  199.                        "0'0-1/16\"" "0'0-1/32\"" "0'0-1/64\""
  200.                        "0'0-1/128\"" "0'0-1/256\"") )
  201.           (setq ulist (list "0'-0\"" "0'-0 1/2\"" "0'-0 1/4\"" "0'-0 1/8\""
  202.                        "0'-0 1/16\"" "0'-0 1/32\"" "0'-0 1/64\""
  203.                        "0'-0 1/128\"" "0'-0 1/256\"") )
  204.         )
  205.       )
  206.       ((= lunits 5) ; fractional
  207.         (if (= (getvar "unitmode") 1)
  208.           (setq ulist (list "0" "0-1/2" "0-1/4" "0-1/8" "0-1/16" "0-1/32"
  209.                        "0-1/64" "0-1/128" "0-1/256") )
  210.           (setq ulist (list "0" "0 1/2" "0 1/4" "0 1/8" "0 1/16" "0 1/32"
  211.                        "0 1/64" "0 1/128" "0 1/256") )
  212.         )
  213.       )
  214.     )
  215.     (start_list ;|MSG0|;"luprec")
  216.     (mapcar 'add_list ulist)
  217.     (end_list)
  218.     (set_tile ;|MSG0|;"luprec" (itoa luprec))
  219.   )
  220.   ;;
  221.   ;; SET_ALIST - Sets Angles/Precision popup list.
  222.   ;;
  223.   (defun set_alist ()
  224.     (cond
  225.       ((= aunits 0) ; decimal degrees
  226.         (setq alist (list "0" "0.0" "0.00" "0.000" "0.0000" "0.00000"
  227.                        "0.000000" "0.0000000" "0.00000000"))
  228.       )
  229.       ((= aunits 1) ; degrees minutes seconds
  230.         (setq alist (list "0d" "0d00'" "0d00'00\""
  231.                        "0d00'00.0\"" "0d00'00.00\"" "0d00'00.000\""
  232.                         "0d00'00.0000\""))
  233.       )
  234.       ((= aunits 2) ; grads
  235.         (setq alist (list "0g" "0.0g" "0.00g" "0.000g" "0.0000g"
  236.                     "0.00000g" "0.000000g" "0.0000000g" "0.00000000g"))
  237.       )
  238.       ((= aunits 3) ; radians
  239.         (setq alist (list "0r" "0.0r" "0.00r" "0.000r" "0.0000r" "0.00000r"
  240.                         "0.000000r" "0.0000000r" "0.00000000r"))
  241.       )
  242.       ((= aunits 4) ; surveyor
  243.         (if (= (getvar "unitmode") 1)
  244.           (setq alist (list "N0dE" "N0d00'E"
  245.                   "N0d00'00\"E" "N0d00'00.0\"E"
  246.            "N0d00'00.00\"E" "N0d00'00.000\"E" "N0d00'00.0000\"E"))
  247.           (setq alist (list "N 0d E" "N 0d00' E"
  248.                   "N 0d00'00\" E" "N 0d00'00.0\" E"
  249.            "N 0d00'00.00\" E" "N 0d00'00.000\" E" "N 0d00'00.0000\" E"))
  250.         )
  251.       )
  252.     )
  253.     (start_list ;|MSG0|;"auprec")
  254.     (mapcar 'add_list alist)
  255.     (end_list)
  256.     ;; auprec 1 is equivalent to 2 for DMS and Surveyors.
  257.     ;; likewise for auprec 3 and 4.
  258.     (if (or (= aunits 1) (= 4 aunits))
  259.       (progn
  260.         (cond
  261.           ((= 0 auprec)
  262.             (set_tile ;|MSG0|;"auprec" "0")
  263.           )
  264.           ((or (= 1 auprec) (= 2 auprec))
  265.             (set_tile ;|MSG0|;"auprec" "1")
  266.           )
  267.           ((or (= 3 auprec) (= 4 auprec))
  268.             (set_tile ;|MSG0|;"auprec" "2")
  269.           )
  270.           ((> auprec 4)
  271.             (set_tile ;|MSG0|;"auprec" (itoa (- auprec 2)))
  272.           )
  273.         )
  274.       )
  275.     ;else
  276.       (set_tile ;|MSG0|;"auprec" (itoa auprec))
  277.     )
  278.   )
  279.   ;;
  280.   ;; Function to update the radio button states.
  281.   ;;
  282.   (defun do_news_buttons()
  283.     (cond
  284.       ((equal temp_abase 0.0 0.01)
  285.         (set_tile ;|MSG0|;"east" "1")
  286.       )
  287.       ((equal temp_abase 1.57 0.01)
  288.           (set_tile ;|MSG0|;"north" "1")
  289.       )
  290.       ((equal temp_abase 3.14 0.01)
  291.         (set_tile ;|MSG0|;"west" "1")
  292.       )
  293.       ((equal temp_abase 4.71 0.01)
  294.           (set_tile ;|MSG0|;"south" "1")
  295.       )
  296.       (T
  297.         (setq other 1)
  298.         (set_tile ;|MSG0|;"other" "1")
  299.       )
  300.     )
  301.     (set_tile ;|MSG0|;"angle_edit" (angtos (+ temp_abase angbase) aunits auprec))
  302.  
  303.     (if (= other 0)
  304.       (progn
  305.         (mode_tile ;|MSG0|;"angle_edit" 1)
  306.         (mode_tile ;|MSG0|;"angle_pick" 1)
  307.       )
  308.       (progn
  309.         (mode_tile ;|MSG0|;"angle_edit" 0)
  310.         (mode_tile ;|MSG0|;"angle_pick" 0)
  311.       )
  312.     )
  313.     
  314.   )
  315.   ;;
  316.   ;; Function to udate the radion button "angle" text.  Only North/South 
  317.   ;; switch.
  318.   ;;
  319.   (defun do_text_update()
  320.     (set_tile ;|MSG0|;"angle_edit" (angtos (+ temp_abase angbase) aunits auprec))
  321.  
  322.     (if (= other 0)
  323.       (progn
  324.         (mode_tile ;|MSG0|;"angle_edit" 1)
  325.         (mode_tile ;|MSG0|;"angle_pick" 1)
  326.       )
  327.       (progn
  328.         (mode_tile ;|MSG0|;"angle_edit" 0)
  329.         (mode_tile ;|MSG0|;"angle_pick" 0)
  330.       )
  331.     )
  332.     (cond
  333.       ((= aunits 0) ; Decimal degrees
  334.         (set_tile ;|MSG0|;"zero" "  0.0")
  335.         (set_tile ;|MSG0|;"one_eighty" "180.0")
  336.         (if (= 1 temp_angdir)
  337.           (progn
  338.             (set_tile ;|MSG0|;"ninety" "270.0")
  339.             (set_tile ;|MSG0|;"two_seventy" " 90.0")
  340.           )
  341.           (progn
  342.             (set_tile ;|MSG0|;"ninety" " 90.0")
  343.             (set_tile ;|MSG0|;"two_seventy" "270.0")
  344.           )
  345.         )
  346.       )
  347.       ((= aunits 1) ; Degrees minutes seconds
  348.         (set_tile ;|MSG0|;"zero" "  0d0'0''")
  349.         (set_tile ;|MSG0|;"one_eighty" "180d0'0''")
  350.         (if (= 1 temp_angdir)
  351.           (progn
  352.             (set_tile ;|MSG0|;"ninety" "270d0'0''")
  353.             (set_tile ;|MSG0|;"two_seventy" " 90d0'0''")
  354.           )
  355.           (progn
  356.             (set_tile ;|MSG0|;"ninety" " 90d0'0''")
  357.             (set_tile ;|MSG0|;"two_seventy" "270d0'0''")
  358.           )
  359.         )
  360.       )
  361.       ((= aunits 2) ; Grads
  362.         (set_tile ;|MSG0|;"zero" "  0g")
  363.         (set_tile ;|MSG0|;"one_eighty" "200g")
  364.         (if (= 1 temp_angdir)
  365.           (progn
  366.             (set_tile ;|MSG0|;"ninety" "300g")
  367.             (set_tile ;|MSG0|;"two_seventy" "100g")
  368.           )
  369.           (progn
  370.             (set_tile ;|MSG0|;"ninety" "100g")
  371.             (set_tile ;|MSG0|;"two_seventy" "300g")
  372.           )
  373.         )
  374.       )
  375.       ((= aunits 3) ; Radians
  376.         (set_tile ;|MSG0|;"zero" "0.0000r")
  377.         (set_tile ;|MSG0|;"one_eighty" "3.1416r")
  378.         (if (= 1 temp_angdir)
  379.           (progn
  380.             (set_tile ;|MSG0|;"ninety" "4.7124r")
  381.             (set_tile ;|MSG0|;"two_seventy" "1.5708r")
  382.           )
  383.           (progn
  384.             (set_tile ;|MSG0|;"ninety" "1.5708r")
  385.             (set_tile ;|MSG0|;"two_seventy" "4.7124r")
  386.           )
  387.         )
  388.       ) 
  389.       ((= aunits 4) ; Surveyor
  390.         (set_tile ;|MSG0|;"zero" " E")
  391.         (set_tile ;|MSG0|;"ninety" " N")
  392.         (set_tile ;|MSG0|;"one_eighty" " O")
  393.         (set_tile ;|MSG0|;"two_seventy" " S")
  394.       ) 
  395.     )
  396.   )
  397.   ;;
  398.   ;; SHOW_DIRECTION - Displays the Direction child dialog
  399.   ;;
  400.   (defun show_direction ()
  401.     (if (not (new_dialog ;|MSG0|;"direction" dcl_id))
  402.       (exit)
  403.     )
  404.     ;; Temp variables in case user cancels.
  405.     (if (not temp_abase)
  406.       (setq temp_abase abase)
  407.     )
  408.     (if (not temp_angdir)
  409.       (setq temp_angdir angdir)
  410.     )
  411.     ;;
  412.     ;; Set appropriate angle zero information. (ANGBASE, ANGDIR)
  413.     ;;
  414.     (setq other 0)
  415.     (do_news_buttons)
  416.     (do_text_update)
  417.     ;;
  418.     ;; Set clockwise or counter-clockwise radio cluster
  419.     ;;
  420.     (if (= temp_angdir 1)
  421.       (set_tile ;|MSG0|;"angle_dir_cw" "1")
  422.       (set_tile ;|MSG0|;"angle_dir_ccw" "1")
  423.     )
  424.     ;;
  425.     ;; Dialog actions
  426.     ;;
  427.     (action_tile ;|MSG0|;"east" "(news 0.0)")
  428.     (action_tile ;|MSG0|;"north" "(news 1.570796327)")
  429.     (action_tile ;|MSG0|;"west" "(news 3.141592654)")
  430.     (action_tile ;|MSG0|;"south" "(news 4.71238898)")
  431.     (action_tile ;|MSG0|;"other" "(do_other)")
  432.     (action_tile ;|MSG0|;"angle_edit" "(grab_angle)")
  433.     (action_tile ;|MSG0|;"angle_pick" "(done_dialog 3)")
  434.     (action_tile ;|MSG0|;"angle_dir_cw" "(setq temp_angdir 1)(do_text_update)")
  435.     (action_tile ;|MSG0|;"angle_dir_ccw" "(setq temp_angdir 0)(do_text_update)")
  436.     (action_tile ;|MSG0|;"accept" "(check_input)") 
  437.     (action_tile ;|MSG0|;"cancel" "(done_dialog 0)")
  438.     (setq what_next1 (start_dialog))
  439.     (if (= 3 what_next1)
  440.       (done_dialog 2)
  441.     )
  442.     (if (= 0 what_next1)
  443.       (progn
  444.         (setq temp_angdir nil)
  445.         (setq temp_abase nil)
  446.       )
  447.     )
  448.   )
  449.   (defun news (r)
  450.      (setq other 0)
  451.      (set_tile ;|MSG0|;"error" "")
  452.      (cond 
  453.        ((and (equal r 1.5707  0.0001)
  454.              (= 1 temp_angdir)
  455.         )
  456.          (setq r 4.71238898)
  457.        )
  458.        ((and (equal r 4.712 0.0001)
  459.             (= 1 temp_angdir)
  460.         )
  461.          (setq r 1.570796327)
  462.        )
  463.        (t)
  464.      )
  465.      (setq temp_abase r)
  466.      (set_tile ;|MSG0|;"angle_edit" (angtos (+ temp_abase angbase) aunits auprec))
  467.      (mode_tile ;|MSG0|;"angle_edit" 1)
  468.      (mode_tile ;|MSG0|;"angle_pick" 1)
  469.   )
  470.   (defun do_other ()
  471.     (setq other 1)
  472.     (mode_tile ;|MSG0|;"angle_pick" 0)
  473.     (mode_tile ;|MSG0|;"angle_edit" 0)
  474.     (mode_tile ;|MSG0|;"angle_edit" 2)
  475.   )
  476.   ;;
  477.   ;;  SHOW_DIALOG - loads, initializes, displays the main dialogue.
  478.   ;;
  479.   (defun show_dialog ()
  480.     (setq what_next 5)
  481.     (setq what_next1 nil)
  482.     ;;
  483.     ;; Loads the dialogue "ddunits" from the id - dcl_id.
  484.     ;;
  485.     (while (< 1 what_next)
  486.       (if (not (new_dialog ;|MSG0|;"ddunits" dcl_id))
  487.         (exit)
  488.       )
  489.       ;;
  490.       ;; Set Units cluster according to value of LUNITS
  491.       ;;
  492.       (eval (nth (1- lunits) '(
  493.               (set_tile ;|MSG0|;"scientific" "1")
  494.               (set_tile ;|MSG0|;"decimal" "1")
  495.               (set_tile ;|MSG0|;"engineering" "1")
  496.               (set_tile ;|MSG0|;"architectural" "1")
  497.               (set_tile ;|MSG0|;"fractional" "1")
  498.                               )
  499.             )
  500.       )
  501.       ;;
  502.       ;; Set Angles cluster according to value of AUNITS.
  503.       ;;
  504.       (eval (nth aunits '(
  505.               (set_tile ;|MSG0|;"decimal_deg" "1")
  506.               (set_tile ;|MSG0|;"dms" "1")
  507.               (set_tile ;|MSG0|;"grads" "1")
  508.               (set_tile ;|MSG0|;"radians" "1")
  509.               (set_tile ;|MSG0|;"surveyor_deg" "1")
  510.                          ) 
  511.             )
  512.       )
  513.       ;;
  514.       ;; Set units and angles precision popup lists
  515.       ;;
  516.       (set_ulist)
  517.       (set_alist)
  518.       ;;
  519.       ;; Actions for the Units/Angles dialogue.
  520.       ;;
  521.       (action_tile ;|MSG0|;"scientific" "(setq lunits 1)(set_ulist)")
  522.       (action_tile ;|MSG0|;"decimal" "(setq lunits 2)(set_ulist)")
  523.       (action_tile ;|MSG0|;"engineering" "(setq lunits 3)(set_ulist)")
  524.       (action_tile ;|MSG0|;"architectural" "(setq lunits 4)(set_ulist)")
  525.       (action_tile ;|MSG0|;"fractional" "(setq lunits 5)(set_ulist)")
  526.       (action_tile ;|MSG0|;"luprec" "(setq luprec (atoi $value))")
  527.       (action_tile ;|MSG0|;"auprec" "(fix_auprec (atoi $value))")
  528.       (action_tile ;|MSG0|;"decimal_deg" "(setq aunits 0)(set_alist)")
  529.       (action_tile ;|MSG0|;"dms" "(setq aunits 1)(set_alist)")
  530.       (action_tile ;|MSG0|;"grads" "(setq aunits 2)(set_alist)")
  531.       (action_tile ;|MSG0|;"radians" "(setq aunits 3)(set_alist)")
  532.       (action_tile ;|MSG0|;"surveyor_deg" "(setq aunits 4)(set_alist)")
  533.       (action_tile ;|MSG0|;"accept" "(s_unit)(setq f_done 1)(done_dialog 1)") 
  534.       (action_tile ;|MSG0|;"cancel" "(done_dialog 0)(setq f_done 1)")
  535.       (action_tile ;|MSG0|;"dir" "(show_direction)")
  536.       (action_tile ;|MSG0|;"help" "(help \"\" \"ddunits\")")
  537.       ;;
  538.       ;; Display the main dialogue.
  539.       ;;
  540.       (cond
  541.         ((= what_next1 3)
  542.          (show_direction)
  543.          (if (/= 3 what_next1)(setq what_next (start_dialog)))
  544.         )
  545.         (T (setq what_next (start_dialog)))
  546.       )
  547.       (cond 
  548.         ((= 2 what_next) 
  549.           (setq temp_abase (getorient "\nDesignar ßngulo: "))
  550.         )
  551.       )
  552.     )
  553.   )
  554.   (defun fix_auprec (value)
  555.     (setq auprec value)
  556.     ;; auprec 1 is equivalent to 2 for DMS and Surveyors.
  557.     ;; likewise for auprec 3 and 4.
  558.     (if (or (= aunits 1) (= 4 aunits))
  559.       (progn
  560.         (cond
  561.           ( (= 0 value)
  562.             (setq auprec 0)
  563.           )
  564.           ( (= 1 value) 
  565.             (setq auprec 1)
  566.           )
  567.           ( (= 2 value)
  568.             (setq auprec 3)
  569.           )
  570.           ( (> value 2)
  571.             (setq auprec (+ 2 value))
  572.           )
  573.         )
  574.       )
  575.     ;else
  576.       (set_tile ;|MSG0|;"auprec" (itoa auprec))
  577.     )
  578.   )
  579.   ;;
  580.   ;; Pop up the dialogue.
  581.   ;;
  582.   (defun ddunits_main()
  583.     ;;
  584.     ;; Set initial checking flags.
  585.     ;;
  586.     (setq f_done 0)
  587.     (setq other 0)
  588.     ;;
  589.     ;; Read system variables for program modification.
  590.     ;;
  591.     (setq angbase (getvar "ANGBASE"))
  592.     (setq abase angbase) ; preserve original value of ANGBASE
  593.     (setq angdir (getvar "ANGDIR"))
  594.     (setq aunits (getvar "AUNITS"))
  595.     (setq lunits (getvar "LUNITS"))
  596.     (if (> (setq auprec (getvar "AUPREC")) 8)
  597.       (setq auprec 8)
  598.     )
  599.     (if (> (setq luprec (getvar "LUPREC")) 8)
  600.       (setq luprec 8)
  601.     )
  602.     ;;
  603.     ;; Main loop.
  604.     ;;
  605.     (while (/= f_done 1)
  606.       (show_dialog)
  607.     )
  608.   )
  609.  
  610.   ;; Set up error function.
  611.   (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
  612.         old_error  *error*            ; save current error function
  613.         *error* ai_error              ; new error function
  614.   )
  615.  
  616.   (setvar "cmdecho" 0)
  617.  
  618.   (cond
  619.      (  (not (ai_trans)))                        ; transparent OK
  620.      (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
  621.      (  (not (setq dcl_id (ai_dcl ;|MSG0|;"ddunits"))))  ; is .DCL file loaded?
  622.      (T 
  623.         (if (/= 1 (logand (getvar "cmdactive") 1)) (ai_undo_push))
  624.         (ddunits_main)                           ; proceed!
  625.         (if (/= 1 (logand (getvar "cmdactive") 1)) (ai_undo_pop))
  626.      )
  627.   )
  628.  
  629.   (setq *error* old_error) 
  630.   (setvar "cmdecho" old_cmd)
  631.   (princ)
  632. )
  633.  
  634. ;;;------------------------------------------------------------------------
  635.  
  636. (princ "  DDUNITS cargada.")
  637. (princ)
  638.  
  639.