home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 11.img / BONUS2.LIB / EP.LSP < prev    next >
Encoding:
Text File  |  1993-02-09  |  4.9 KB  |  137 lines
  1. ;;;   EP.lsp   ¬⌐Ñ╗ 1.0
  2. ;;;   (C) ¬⌐┼v 1988-1992  Autodesk ñ╜Ñq
  3. ;;;
  4. ;;;   Ñ╗╡{ªíñwÑ╤ Autodesk ñ╜Ñq╡∙ÑU¬⌐┼v, ╢╚⌐≤ñU¡z▒í¬pñUÑi▒┬╗P▒zíu│\ÑiívíC
  5. ;;;   ╗╒ñUñú▒oÑHÑ⌠ª≤º╬ªí╡oªµ⌐╬ÑX¬⌐ª╣╡{ªí¬║íu¡∞⌐l╜Xív; ª²ñ╣│\▒zªb»S⌐w¡lÑ═
  6. ;;;   ¬║ñuº@ñW╡▓ªXª╣╡{ªí¬║íuÑ╪¬║╜Xív¿╧Ñ╬íCª│├÷│o├■¡lÑ═ñuº@¬║▒°Ñ≤ªpñU:
  7. ;;;
  8. ;;;   ( i)  │]¡pñW╗Pñuº@ñW¼╥»┬║Θ░w╣∩ Autodesk ñ╜Ñq¬║▓ú½~íC
  9. ;;;   (ii)  ╕ⁿª│íu¬⌐┼v  (C) 1988-1992  Autodesk ñ╜Ñqív¬║¬⌐┼v│qºiíC
  10. ;;;
  11. ;;;
  12. ;;;
  13. ;;;   AUTODESKñ╜Ñq┤ú¿╤ª╣╡{ªí╢╚¿╤º@íu├■ªⁿív¬║░╤ª╥, ª╙ÑBñú▒╞░úª│Ñ⌠ª≤┐∙╗~¬║
  14. ;;;   Ñi»αíCAUTODESKñ╜Ñq»Sª╣º_╗{Ñ⌠ª≤»S⌐wÑ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºt
  15. ;;;   ÑX¿π¬║½O├╥íCAUTODESKñ╜ÑqªP«╔ÑτñúÑX¿πª╣╡{ªí░⌡ªµ«╔ñ@⌐wñú╖|íuññ┬_ív⌐╬
  16. ;;;   íuº╣Ñ■╡L╗~ív¬║½O├╥íC
  17. ;;;
  18. ;;;
  19. ;;;   By Troy Davis / revised by Steve McCall
  20. ;;;   Autodesk, Inc.  May 1, 1990
  21. ;;;---------------------------------------------------------------------------
  22. ;;; DESCRIPTION
  23. ;;;
  24. ;;;   EP.LSP  (Enter Point) --  prompts the user for coordinate point entries;
  25. ;;;   makes it easy to distinguish between WCS or UCS Absolute or
  26. ;;;   Relative - or Cartesian, Cylindrical or Spherical entries.
  27. ;;;   (Quick, what is  "@*123<45,67" ???).  You can also reset the
  28. ;;;   "lastpoint" system variable for Relative entries.
  29. ;;;
  30. ;;;   After this Lisp function is loaded <(load "ep")>, it can be
  31. ;;;   used anytime AutoCAD requires a point. Just enter "(ep)"
  32. ;;;   at the point prompt.
  33. ;;;
  34. ;;;   You will then be prompted:
  35. ;;;
  36. ;;;   Exit/World/Absolute to UCS origin/Set lastpoint/<Relative to lastpoint>:
  37. ;;;
  38. ;;;   Enter a letter:  e, w, a, s, or  r<default>, and follow the
  39. ;;;   prompts. "w" (World) also allows Absolute or Relative.
  40. ;;;
  41. ;;;   The function then assembles the proper point entry, which is
  42. ;;;   given to the AutoCAD prompt and echoed to the screen so you can
  43. ;;;   see how that point would be specified.
  44. ;;;
  45. ;;;   You can enter "E" (Exit) at any time to return to normal point
  46. ;;;   entry; cancelling the function will also cancel the parent
  47. ;;;   command.  All variables are local.  This function cannot be
  48. ;;;   used to respond to an AutoLISP prompt.
  49. ;;;
  50. ;;;---------------------------------------------------------------------------
  51.  
  52.  
  53. (defun myerr (msg)
  54.    (if (/= msg "Function cancelled")
  55.       (princ (strcat "\n┐∙╗~: " msg))
  56.    )
  57.    (setq *error* olderr)
  58.    (princ)
  59. )
  60. (defun ep ( / fp1 fp2 fp3 fp4 fp5 fp6 fp7 fp8 fp9 fp10)
  61.   (setq olderr *error*
  62.         *error* myerr
  63.   )
  64.   (while
  65.     (not
  66.       (=
  67.         (progn
  68.           (initget "Exit World Absolute Set Relative")
  69.           (setq fp1 (getkword (strcat
  70.           "\nE░hÑX/WÑ@¼╔/A╡┤╣∩ (UCS¡∞┬I)/"
  71.           "S│]íu│╠½ßñ@┬Iív/<R¼█╣∩íu│╠½ßñ@┬Iív>: ")))
  72.         )
  73.         "Exit"
  74.       )
  75.     )
  76.     (if (= fp1 "Set")
  77.       (setvar "LASTPOINT" (getpoint "R░╤ª╥┬I: "))
  78.       (progn
  79.         (setq fp10 "UCS")
  80.         (if (= fp1 "World")
  81.           (progn
  82.             (initget "Absolute Relative")
  83.             (setq fp10 "WCS"
  84.                   fp2 (getkword
  85.                     "A╡┤╣∩ (WCS ¡∞┬I)/<R¼█╣∩íu│╠½ßñ@┬Iív>: ")
  86.             )
  87.             (if (= fp2 "Absolute")
  88.                (setq fp3 "*" fp4 (trans (list 0.0 0.0 0.0) 0 1))
  89.                (setq fp3 "@*" fp4 (getvar "lastpoint"))
  90.             )
  91.           )
  92.           (if (= fp1 "Absolute")
  93.             (setq fp3 "" fp4 (list 0.0 0.0 0.0))
  94.             (setq fp3 "@" fp4 (getvar "lastpoint"))
  95.           )
  96.         )
  97.         (initget "Xyz Spherical Cylindrical")
  98.         (setq fp5 (getkword "Xyz/C╢Ω¼W«y╝╨/<S╢Ω▓y«y╝╨>: "))
  99.         (initget 1)
  100.         (if (= fp5 "Cylindrical")
  101.           (progn
  102.             (setq fp6 (getdist fp4 "┐ΘñJ XY Ñ¡¡▒ñW¬║╢Z┬≈: "))
  103.             (initget 1) (setq fp7 (getangle fp4 "┐ΘñJ╗PíuX ╢bív¬║º¿¿ñ: "))
  104.             (initget 1) (setq fp8 (getdist fp4 "┐ΘñJ¬uíuZ ╢bív¬║ª∞▓╛: "))
  105.             (setq fp9 (strcat fp3 (rtos fp6) "<" (angtos fp7) "," (rtos fp8)))
  106.           )
  107.           (if (= fp5 "Xyz")
  108.             (progn
  109.               (setq fp6 (getdist (strcat
  110.                 "┐ΘñJ¬u " fp10 " ñºíuX ╢bív¬║ª∞▓╛: ")))
  111.               (initget 1) (setq fp7 (getdist (strcat
  112.                 "┐ΘñJ¬u " fp10 " ñºíuY ╢bív¬║ª∞▓╛: ")))
  113.               (initget 1) (setq fp8 (getdist (strcat
  114.                 "┐ΘñJ¬u " fp10 " ñºíuZ ╢bív¬║ª∞▓╛: ")))
  115.               (setq fp9 (strcat fp3 (rtos fp6) ","
  116.                                     (rtos fp7) "," (rtos fp8)))
  117.             )
  118.             (progn
  119.               (setq fp6 (getdist fp4 "┐ΘñJ 3D ╢Z┬≈: "))
  120.               (initget 1) (setq fp7 (getangle fp4 "┐ΘñJ╗PíuX ╢bív¬║º¿¿ñ: "))
  121.               (initget 1) (setq fp8 (getangle fp4
  122.                 "┐ΘñJÑ╤íuXY Ñ¡¡▒ív╢q░_¬║Ñ⌡¿ñ: "))
  123.               (setq fp9 (strcat fp3 (rtos fp6) "<" (angtos fp7) "<"
  124.                                                    (angtos fp8)))
  125.             )
  126.           )
  127.         )
  128.         (command fp9)
  129.       )
  130.     )
  131.   )
  132.   (setq *error* olderr)
  133.   (princ)
  134. )
  135. (princ "\n\tíuEpívñw╕ⁿñJ; ╗▌┐ΘñJ┬Iª∞«╔╜╨ÑH (ep) ▒╥░╩½ⁿÑOíC")
  136. (princ)
  137.