home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 5.img / SUPPORT2.LIB / DDUNITS.LSP < prev    next >
Encoding:
Text File  |  1992-09-08  |  15.6 KB  |  495 lines
  1. ;;; DDUNITS.LSP
  2. ;;; ¬⌐┼v (C) 1992  Autodesk ñ╜Ñq
  3. ;;;
  4. ;;; Ñ╗│n┼ΘºK╢O¿╤▒z╢iªµÑ⌠ª≤Ñ╬│~╗▌¿D¬║½■¿⌐íB¡╫º∩ñ╬╡oªµ, ª²¼O░╚╜╨┐φ┤`ñU¡z
  5. ;;; ¡∞½h :
  6. ;;;
  7. ;;; 1)  ñWªC¬║¬⌐┼v│qºi░╚╗▌ÑX▓{ªb¿Cñ@Ñ≈½■¿⌐∙╪íC
  8. ;;; 2)  ¼█├÷¬║╗í⌐·ñσÑ≤ñ]Ñ▓╢╖⌐·╕ⁿ¬⌐┼v│qºiñ╬Ñ╗╢╡│\Ñi│qºiíC
  9. ;;;
  10. ;;; Ñ╗│n┼Θ╢╚┤ú¿╤º@¼░└│Ñ╬ñW¬║░╤ª╥, ª╙Ñ╝┴n⌐·⌐╬┴⌠ºtÑ⌠ª≤½O├╥; ╣∩⌐≤Ñ⌠ª≤»S«φ
  11. ;;; Ñ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºtÑX¿π¬║½O├╥, ªbª╣ñ@╖ºñ⌐ÑHº_╗{íC
  12. ;;;
  13. ;;;
  14. ;;;---------------------------------------------------------------------
  15. ;;;   DESCRIPTION
  16. ;;;
  17. ;;;   DDUNITS.LSP is designed to provide a quick and easy interface to the
  18. ;;;   existing AutoCAD UNITS command. DDUNITS.LSP utilizes DDUNITS.DCL to
  19. ;;;   provide a layout for the DDUNITS dialogue box.
  20. ;;;
  21. ;;;   The routine affects the following system variables:
  22. ;;;       LUNITS, LUPREC, AUNITS, AUPREC, ANGBASE, and ANGDIR.
  23. ;;;
  24. ;;;--------------------------------------------------------------------
  25. ;;;   OPERATION
  26. ;;;
  27. ;;;   After loading the routine, it is started by typing DDUNITS. This will
  28. ;;;   load up the Proteus Dialogue interface. The current settings are
  29. ;;;   displayed in the dialogue.
  30. ;;;
  31. ;;;   Any or all aspects of the units command can be changed and the new
  32. ;;;   value will take affect when the OK button is pressed. The Units
  33. ;;;   modes are selected by selecting the appropriate radio buttons. Each
  34. ;;;   time a setting is chosen an example is shown in a popup list, which
  35. ;;;   also is used to change the precision of the units. To choose the
  36. ;;;   angle direction (ANGDIR), press the "Direction..." button. Another
  37. ;;;   dialogue appears; standard choices are listed in a radio cluster and
  38. ;;;   an option for "Other" is given to allow for a screen picked angle or
  39. ;;;   a keyed in angle.
  40. ;;;
  41. ;;;   Choosing the OK button accepts the currently displayed settings and
  42. ;;;   sets the appropriate system variables. Choosing the CANCEL button
  43. ;;;   will abort the dialogue and leave the system "as-is." A Help button
  44. ;;;   is available to display the AutoCAD help information on the units
  45. ;;;   command.
  46. ;;;----------------------------------------------------------------------
  47. ;;;
  48. ;;;==================== load-time error checking ========================
  49.  
  50.   (defun ai_abort (app msg)
  51.      (defun *error* (s)
  52.         (if old_error (setq *error* old_error))
  53.         (princ)
  54.      )
  55.      (if msg
  56.        (alert (strcat " └│Ñ╬╡{ªí┐∙╗~: "
  57.                       app
  58.                       " \n\n  "
  59.                       msg
  60.                       "  \n"
  61.               )
  62.        )
  63.      )
  64.      (exit)
  65.   )
  66.  
  67. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
  68. ;;; and then try to load it.
  69. ;;;
  70. ;;; If it can't be found or it can't be loaded, then abort the
  71. ;;; loading of this file immediately, preserving the (autoload)
  72. ;;; stub function.
  73.  
  74.   (cond
  75.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
  76.  
  77.      (  (not (findfile "ai_utils.lsp"))                     ; find it
  78.         (ai_abort "DDUNITS"
  79.                   (strcat "ºΣñú¿∞íuAI_UTILS.LSPív└╔«╫;"
  80.                           "\n  ╜╨└╦¼díusupportívÑ╪┐²íC")))
  81.  
  82.      (  (eq "failed" (load "ai_utils" "failed"))            ; load it
  83.         (ai_abort "DDUNITS" "╡L¬k╕ⁿñJíuAI_UTILS.LSPív└╔«╫"))
  84.   )
  85.  
  86.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
  87.       (ai_abort "DDUNITS" nil)         ; a Nil <msg> supresses
  88.   )                                    ; ai_abort's alert box dialog.
  89.  
  90. ;;;==================== end load-time operations ========================
  91.  
  92. (defun c:ddunits (/
  93.                    abase      auprec     luprec       ulist
  94.                    alist                 old_cmd      what_next
  95.                    angbase    dcl_id     old_error    what_next1
  96.                    angdir     f_done     other
  97.                    aunits     lunits     tmp_base     undo_init
  98.                  )
  99.   ;;
  100.   ;; CHECK_INPUT  - checks input (angle zero direction edit box)
  101.   ;;           called when OK is pressed in Direction child dialog.
  102.   (defun check_input ()
  103.     (if (= 1 (atoi (get_tile "other")))
  104.       (if (not (setq tmp_base (angtof (get_tile "angle_edit") aunits)))
  105.         (progn
  106.           (set_tile "error" "íu¿ñ½╫ív╡L«─ íC")
  107.           (mode_tile "angle_edit" 2)
  108.         )
  109.         (progn
  110.           (setq abase (- tmp_base angbase))
  111.           (done_dialog)
  112.         )
  113.       )
  114.       (done_dialog)
  115.     )
  116.   )
  117.   ;;
  118.   ;; S_UNIT - sets the system variables - called when OK is pressed.
  119.   ;;
  120.   (defun s_unit ()
  121.     (if (/= abase angbase)
  122.       (setvar "ANGBASE" abase)
  123.     )
  124.     (setvar "ANGDIR" angdir)
  125.     (setvar "AUNITS" aunits)
  126.     (setvar "AUPREC" auprec)
  127.     (setvar "LUNITS" lunits)
  128.     (setvar "LUPREC" luprec)
  129.   )
  130.   ;;
  131.   ;; GRAB_ANGLE - action function for the Direction/Angle edit box.
  132.   ;;
  133.   (defun grab_angle()
  134.     (set_tile "error" "")
  135.     (if (not (setq tmp_base (angtof (get_tile "angle_edit") aunits)))
  136.       (set_tile "error" "íu¿ñ½╫ív╡L«─íC")
  137.       (progn
  138.         (setq abase (- tmp_base angbase))
  139.         (set_tile "angle_edit" (angtos tmp_base aunits auprec))
  140.       )
  141.     )
  142.   )
  143.   ;;
  144.   ;; SET_ULIST - Sets Units/Precision popup list.
  145.   ;;
  146.   (defun set_ulist ()
  147.     (cond
  148.       ((= lunits 1) ; scientific
  149.         (setq ulist (list "0E+01" "0.0E+01" "0.00E+01" "0.000E+01"
  150.                        "0.0000E+01" "0.00000E+01" "0.000000E+01"
  151.                        "0.0000000E+01" "0.00000000E+01") )
  152.       )
  153.       ((= lunits 2) ; decimal
  154.         (setq ulist (list "0" "0.0" "0.00" "0.000" "0.0000" "0.00000"
  155.                        "0.000000" "0.0000000" "0.00000000") )
  156.       )
  157.       ((= lunits 3) ; engineering
  158.         (setq ulist (list "0'-0\"" "0'-0.0\"" "0'-0.00\"" "0'-0.000\""
  159.                        "0'-0.0000\"" "0'-0.00000\"" "0'-0.000000\""
  160.                        "0'-0.0000000\"" "0'-0.00000000\"") )
  161.       )
  162.       ((= lunits 4) ; architectural
  163.         (setq ulist (list "0'-0\"" "0'-0 1/2\"" "0'-0 1/4\"" "0'-0 1/8\""
  164.                        "0'-0 1/16\"" "0'-0 1/32\"" "0'-0 1/64\""
  165.                        "0'-0 1/128\"" "0'-0 1/256\"") )
  166.       )
  167.       ((= lunits 5) ; fractional
  168.         (setq ulist (list "0" "0 1/2" "0 1/4" "0 1/8" "0 1/16" "0 1/32"
  169.                        "0 1/64" "0 1/128" "0 1/256") )
  170.       )
  171.     )
  172.     (start_list "luprec")
  173.     (mapcar 'add_list ulist)
  174.     (end_list)
  175.     (set_tile "luprec" (itoa luprec))
  176.   )
  177.   ;;
  178.   ;; SET_ALIST - Sets Angles/Precision popup list.
  179.   ;;
  180.   (defun set_alist ()
  181.     (cond
  182.       ((= aunits 0) ; decimal degrees
  183.         (setq alist (list "0" "0.0" "0.00" "0.000" "0.0000" "0.00000"
  184.                        "0.000000" "0.0000000" "0.00000000"))
  185.       )
  186.       ((= aunits 1) ; degrees minutes seconds
  187.         (setq alist (list "0d" "0d00'" "0d00'" "0d00'00\"" "0d00'00\""
  188.                        "0d00'00.0\"" "0d00'00.00\"" "0d00'00.000\""
  189.                         "0d00'00.0000\""))
  190.       )
  191.       ((= aunits 2) ; grads
  192.         (setq alist (list "0g" "0.0g" "0.00g" "0.000g" "0.0000g"
  193.                     "0.00000g" "0.000000g" "0.0000000g" "0.00000000g"))
  194.       )
  195.       ((= aunits 3) ; radians
  196.         (setq alist (list "0r" "0.0r" "0.00r" "0.000r" "0.0000r" "0.00000r"
  197.                         "0.000000r" "0.0000000r" "0.00000000r"))
  198.       )
  199.       ((= aunits 4) ; surveyor
  200.         (setq alist (list "N 0d E" "N 0d00' E" "N 0d00' E"
  201.                   "N 0d00'00\" E" "N 0d00'00\" E" "N 0d00'00.0\" E"
  202.           "N 0d00'00.00\" E" "N 0d00'00.000\" E" "N 0d00'00.0000\" E"))
  203.       )
  204.     )
  205.     (start_list "auprec")
  206.     (mapcar 'add_list alist)
  207.     (end_list)
  208.     (set_tile "auprec" (itoa auprec))
  209.   )
  210.   ;;
  211.   ;; SHOW_DIRECTION - Displays the Direction child dialog
  212.   ;;
  213.   (defun show_direction ()
  214.     (if (not (new_dialog "direction" dcl_id))
  215.       (exit)
  216.     )
  217.     ;;
  218.     ;; Set appropriate angle zero information. (ANGBASE, ANGDIR)
  219.     ;;
  220.     (setq other 0)
  221.     (cond
  222.       ((equal abase 0.0 0.01)
  223.         (set_tile "east" "1")
  224.       )
  225.       ((equal abase 1.57 0.01)
  226.         (if (= 1 angdir)
  227.           (set_tile "south" "1")
  228.           (set_tile "north" "1")
  229.         )
  230.       )
  231.       ((equal abase 3.14 0.01)
  232.         (set_tile "west" "1")
  233.       )
  234.       ((equal abase 4.71 0.01)
  235.         (if (= 1 angdir)
  236.           (set_tile "north" "1")
  237.           (set_tile "south" "1")
  238.         )
  239.       )
  240.       (T
  241.         (setq other 1)
  242.         (set_tile "other" "1")
  243.       )
  244.     )
  245.     (set_tile "angle_edit" (angtos (+ abase angbase) aunits auprec))
  246.     (if (= other 0)
  247.       (progn
  248.         (mode_tile "angle_edit" 1)
  249.         (mode_tile "angle_pick" 1)
  250.       )
  251.       (progn
  252.         (mode_tile "angle_edit" 0)
  253.         (mode_tile "angle_pick" 0)
  254.       )
  255.     )
  256.     (cond
  257.       ((= aunits 0) ; Decimal degrees
  258.         (set_tile "zero" "  0.0")
  259.         (set_tile "one_eighty" "180.0")
  260.         (if (= 1 angdir)
  261.           (progn
  262.             (set_tile "ninety" "270.0")
  263.             (set_tile "two_seventy" " 90.0")
  264.           )
  265.           (progn
  266.             (set_tile "ninety" " 90.0")
  267.             (set_tile "two_seventy" "270.0")
  268.           )
  269.         )
  270.       )
  271.       ((= aunits 1) ; Degrees minutes seconds
  272.         (set_tile "zero" "  0d0'0''")
  273.         (set_tile "one_eighty" "180d0'0''")
  274.         (if (= 1 angdir)
  275.           (progn
  276.             (set_tile "ninety" "270d0'0''")
  277.             (set_tile "two_seventy" " 90d0'0''")
  278.           )
  279.           (progn
  280.             (set_tile "ninety" " 90d0'0''")
  281.             (set_tile "two_seventy" "270d0'0''")
  282.           )
  283.         )
  284.       )
  285.       ((= aunits 2) ; Grads
  286.         (set_tile "zero" "  0g")
  287.         (set_tile "one_eighty" "200g")
  288.         (if (= 1 angdir)
  289.           (progn
  290.             (set_tile "ninety" "300g")
  291.             (set_tile "two_seventy" "100g")
  292.           )
  293.           (progn
  294.             (set_tile "ninety" "100g")
  295.             (set_tile "two_seventy" "300g")
  296.           )
  297.         )
  298.       )
  299.       ((= aunits 3) ; Radians
  300.         (set_tile "zero" "0.0000r")
  301.         (set_tile "one_eighty" "3.1416r")
  302.         (if (= 1 angdir)
  303.           (progn
  304.             (set_tile "ninety" "4.7124r")
  305.             (set_tile "two_seventy" "1.5708r")
  306.           )
  307.           (progn
  308.             (set_tile "ninety" "1.5708r")
  309.             (set_tile "two_seventy" "4.7124r")
  310.           )
  311.         )
  312.       )
  313.       ((= aunits 4) ; Surveyor
  314.         (set_tile "zero" " E")
  315.         (set_tile "ninety" " N")
  316.         (set_tile "one_eighty" " W")
  317.         (set_tile "two_seventy" " S")
  318.       )
  319.     )
  320.     ;;
  321.     ;; Set clockwise or counter-clockwise radio cluster
  322.     ;;
  323.     (if (= angdir 1)
  324.       (set_tile "angle_dir_cw" "1")
  325.       (set_tile "angle_dir_ccw" "1")
  326.     )
  327.     ;;
  328.     ;; Dialog actions
  329.     ;;
  330.     (action_tile "east" "(news 0.0)")
  331.     (action_tile "north" "(news 1.570796327)")
  332.     (action_tile "west" "(news 3.141592654)")
  333.     (action_tile "south" "(news 4.71238898)")
  334.     (action_tile "other" "(do_other)")
  335.     (action_tile "angle_edit" "(grab_angle)")
  336.     (action_tile "angle_pick" "(done_dialog 3)")
  337.     (action_tile "angle_dir_cw" "(setq angdir 1)")
  338.     (action_tile "angle_dir_ccw" "(setq angdir 0)")
  339.     (action_tile "accept" "(check_input)")
  340.     (action_tile "cancel" "(done_dialog)")
  341.     (setq what_next1 (start_dialog))
  342.     (if (= 3 what_next1)
  343.       (done_dialog 2)
  344.     )
  345.   )
  346.   (defun news (r)
  347.      (setq other 0)
  348.      (set_tile "error" "")
  349.      (setq abase r)
  350.      (set_tile "angle_edit" (angtos (+ abase angbase) aunits auprec))
  351.      (mode_tile "angle_edit" 1)
  352.      (mode_tile "angle_pick" 1)
  353.   )
  354.   (defun do_other ()
  355.     (setq other 1)
  356.     (mode_tile "angle_pick" 0)
  357.     (mode_tile "angle_edit" 0)
  358.     (mode_tile "angle_edit" 2)
  359.   )
  360.   ;;
  361.   ;;  SHOW_DIALOG - loads, initializes, displays the main dialogue.
  362.   ;;
  363.   (defun show_dialog ()
  364.     (setq what_next 5)
  365.     (setq what_next1 nil)
  366.     ;;
  367.     ;; Loads the dialogue "ddunits" from the id - dcl_id.
  368.     ;;
  369.     (while (< 1 what_next)
  370.       (if (not (new_dialog "ddunits" dcl_id))
  371.         (exit)
  372.       )
  373.       ;;
  374.       ;; Set Units cluster according to value of LUNITS
  375.       ;;
  376.       (eval (nth (1- lunits) '(
  377.               (set_tile "scientific" "1")
  378.               (set_tile "decimal" "1")
  379.               (set_tile "engineering" "1")
  380.               (set_tile "architectural" "1")
  381.               (set_tile "fractional" "1")
  382.                               )
  383.             )
  384.       )
  385.       ;;
  386.       ;; Set Angles cluster according to value of AUNITS.
  387.       ;;
  388.       (eval (nth aunits '(
  389.               (set_tile "decimal_deg" "1")
  390.               (set_tile "dms" "1")
  391.               (set_tile "grads" "1")
  392.               (set_tile "radians" "1")
  393.               (set_tile "surveyor_deg" "1")
  394.                          )
  395.             )
  396.       )
  397.       ;;
  398.       ;; Set units and angles precision popup lists
  399.       ;;
  400.       (set_ulist)
  401.       (set_alist)
  402.       ;;
  403.       ;; Actions for the Units/Angles dialogue.
  404.       ;;
  405.       (action_tile "scientific" "(setq lunits 1)(set_ulist)")
  406.       (action_tile "decimal" "(setq lunits 2)(set_ulist)")
  407.       (action_tile "engineering" "(setq lunits 3)(set_ulist)")
  408.       (action_tile "architectural" "(setq lunits 4)(set_ulist)")
  409.       (action_tile "fractional" "(setq lunits 5)(set_ulist)")
  410.       (action_tile "luprec" "(setq luprec (atoi $value))")
  411.       (action_tile "auprec" "(setq auprec (atoi $value))")
  412.       (action_tile "decimal_deg" "(setq aunits 0)(set_alist)")
  413.       (action_tile "dms" "(setq aunits 1)(set_alist)")
  414.       (action_tile "grads" "(setq aunits 2)(set_alist)")
  415.       (action_tile "radians" "(setq aunits 3)(set_alist)")
  416.       (action_tile "surveyor_deg" "(setq aunits 4)(set_alist)")
  417.       (action_tile "accept" "(s_unit)(setq f_done 1)(done_dialog)")
  418.       (action_tile "cancel" "(done_dialog)(setq f_done 1)")
  419.       (action_tile "dir" "(show_direction)")
  420.       (action_tile "help" "(acad_helpdlg \"acad.hlp\" \"ddunits\")")
  421.       ;;
  422.       ;; Display the main dialogue.
  423.       ;;
  424.       (cond
  425.         ((= what_next1 3)
  426.          (show_direction)
  427.          (if (/= 3 what_next1)(setq what_next (start_dialog)))
  428.         )
  429.         (T (setq what_next (start_dialog)))
  430.       )
  431.       (cond
  432.         ((= 2 what_next) (setq abase (getorient "\nPick angle: ")))
  433.       )
  434.     )
  435.   )
  436.   ;;
  437.   ;; Pop up the dialogue.
  438.   ;;
  439.   (defun ddunits_main()
  440.     ;;
  441.     ;; Set initial checking flags.
  442.     ;;
  443.     (setq f_done 0)
  444.     (setq other 0)
  445.     ;;
  446.     ;; Read system variables for program modification.
  447.     ;;
  448.     (setq angbase (getvar "ANGBASE"))
  449.     (setq abase angbase) ; preserve original value of ANGBASE
  450.     (setq angdir (getvar "ANGDIR"))
  451.     (setq aunits (getvar "AUNITS"))
  452.     (setq lunits (getvar "LUNITS"))
  453.     (if (> (setq auprec (getvar "AUPREC")) 8)
  454.       (setq auprec 8)
  455.     )
  456.     (if (> (setq luprec (getvar "LUPREC")) 8)
  457.       (setq luprec 8)
  458.     )
  459.     ;;
  460.     ;; Main loop.
  461.     ;;
  462.     (while (/= f_done 1)
  463.       (show_dialog)
  464.     )
  465.   )
  466.  
  467.   ;; Set up error function.
  468.   (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
  469.         old_error  *error*            ; save current error function
  470.         *error* ai_error              ; new error function
  471.   )
  472.  
  473.   (setvar "cmdecho" 0)
  474.  
  475.   (cond
  476.      (  (not (ai_trans)))                        ; transparent OK
  477.      (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
  478.      (  (not (setq dcl_id (ai_dcl "ddunits"))))  ; is .DCL file loaded?
  479.      (T
  480.         (if (/= 1 (logand (getvar "cmdactive"))) (ai_undo_push))
  481.         (ddunits_main)                           ; proceed!
  482.         (if (/= 1 (logand (getvar "cmdactive"))) (ai_undo_pop))
  483.      )
  484.   )
  485.  
  486.   (setq *error* old_error)
  487.   (setvar "cmdecho" old_cmd)
  488.   (princ)
  489. )
  490.  
  491. ;;;------------------------------------------------------------------------
  492.  
  493. (princ "  íuDDUNITSívñw╕ⁿñJíC")
  494. (princ)
  495.