home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / autocad / jul91.arj / TIP679.LSP < prev   
Lisp/Scheme  |  1991-08-27  |  2KB  |  79 lines
  1. ;TIP679.LSP   Get* Function Library   (c)1991, Norman Taylor
  2.  
  3. (defun XGETANGLE (P0 P D)
  4.   (setq P (strcat "\n** " P " <"
  5.     (angtos D) ">: "))
  6.   (if P0
  7.     (cond ((getangle P0 P)) (D))
  8.     (cond ((getangle P)) (D))
  9.   )
  10. )
  11. (defun XGETCORNER (P0 P D / Z)
  12.   (setq Z (if (caddr D)(strcat ","
  13.           (rtos (caddr D))) "")
  14.         P (strcat "\n** " P " <" (rtos
  15.           (car D)) "," (rtos (cadr D))
  16.            Z ">: ")
  17.   )
  18.   (cond ((getcorner P0 P))(D))
  19. )
  20. (defun XGETDIST (P0 P D)
  21.   (setq P (strcat "\n** " P " <" (rtos D)
  22.      ">: "))
  23.   (if P0 (cond ((getdist P0 P))(D))
  24.          (cond ((getdist P))(D))
  25.   )
  26. )
  27. (defun XGETINT (P D)
  28.   (cond ((getint (strcat "\n** " P " <"
  29.     (itoa D) ">: ")))(D))
  30. )
  31. (defun XGETKWORD (OL P D / K O X)
  32.   (setq K "" O "")
  33.   (foreach X OL
  34.     (setq K (strcat K " " X)
  35.           O (if (/= X D)
  36.               (strcat O "/" X)
  37.               O
  38.             )
  39.     )
  40.   )
  41.   (initget (substr K 2))
  42.   (cond ((getkword (strcat "\n** " P
  43.     (substr O 2) "/<" D ">: ")))(D))
  44. )
  45. (defun XGETORIENT (P0 P D)
  46.   (setq P (strcat "\n** " P " <"
  47.     (angtos D) ">: "))
  48.   (if P0 (cond ((getorient P0 P))(D))
  49.          (cond ((getorient P))(D))
  50.   )
  51. )
  52. (defun XGETPOINT (P0 P D)
  53.   (setq P (strcat "\n** " P " <" (rtos
  54.     (car D)) "," (rtos (cadr D))
  55.     (if (caddr D)
  56.       (strcat "," (rtos (caddr D))) ""
  57.     )
  58.     ">: "))
  59.   (if P0 (cond ((getpoint P0 P))(D))
  60.          (cond ((getpoint P))(D))
  61.   )
  62. )
  63. (defun XGETREAL (P D)
  64.   (cond ((getreal (strcat "\** " P " <"
  65.           (rtos D) ">: ")))
  66.         (D)
  67.   )
  68. )
  69. (defun XGETSTRING (CR P D)
  70.   (setq S (getstring CR (strcat "\n** "
  71.           P " <" D ">: "))
  72.         N (strlen S)
  73.         J 1
  74.   )
  75.   (while (and (<= J N)(/= (substr S J 1)
  76.     " "))(setq J (1+ J)))
  77.   (cond ((> J 1)(substr S 1 (1- J)))(D))
  78. )
  79.