home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR038.ZIP / MENU-SYS.ARC / HEADER15.ORG < prev    next >
Lisp/Scheme  |  1987-08-01  |  2KB  |  53 lines
  1. ;; (c)1987                R&J Computer Service
  2. ;                            RR #3  Box 183
  3. ;                          Albion, IN  46701
  4. ;  Phone:                Voice  (219) 636-2460
  5. ;                         Data  (219) 636-3153
  6. ;                   24hrs 2400, 1200, 300 Baud 8-N-1
  7. ;    Header.LSP adds Header Balloon and description to a detail drawing
  8. ;                        Written by John Kitt
  9. ; We are NOT responsable for the performance or accuracy of this LISP routine
  10. ;  You are encouraged to copy and distribute this LISP routine
  11. ;  provided this header section IS NOT REMOVED.  For continued
  12. ;  support and new LISP routines you are asked to mail a Registration
  13. ;  fee of $10.00 to the above address.  Thank You!!!
  14. (defun *ERROR* (st) (princ (strcat "*" st)) ' *)
  15. (defun C:HEADER ()
  16. (setq ECHO (getvar "cmdecho"))
  17. (setvar "cmdecho" 0)
  18. (command "GRAPHSCR")
  19. (setq RAD 0
  20.       RAD1 (/ 270 57.29578)
  21.       PT1 (getpoint "\nEnter Header Balloon location: ")
  22.       HEDRAD 0.3125
  23.       TXTHT 0.25
  24.       OSET (* 0.268 (/ TXTHT 2.0))
  25.       TXTLOC (list (- (car PT1) OSET) (- (cadr PT1) (/ TXTHT 2.0)))
  26.       VAR 0)
  27. (command "CIRCLE" PT1 HEDRAD)
  28. (while (= VAR 0)
  29. (setq HEDTXT (getstring "\nEnter Header number (2 char. max.): "))
  30. (if (> (strlen HEDTXT) 2) (progn (setq VAR 0)
  31. (princ "Invalid Entry....Too Many Charactors"))
  32. (setq VAR 1)))
  33. (command "TEXT" "C" TXTLOC TXTHT 0 HEDTXT)
  34. (setq TMPHT1 (getreal "\nEnter first line text height [0.250]: "))
  35. (if (= TMPHT1 nil) (setq TXTHT1 0.25) (setq TXTHT1 TMPHT1))
  36. (setq TMPPT2 (polar PT1 RAD (+ HEDRAD 0.25))
  37.       PT2 (polar TMPPT2 RAD1 (/ TXTHT1 2.0))
  38.       DESTXT (getstring T "\nEnter first description line: "))
  39. (command "TEXT" PT2 TXTHT1 0 DESTXT)
  40. (setq TMPHT2 (getreal "\nEnter text height for remaining lines [0.125]: "))
  41. (if (= TMPHT2 nil) (setq TXTHT2 0.125) (setq TXTHT2 TMPHT2))
  42. (setq TEST 1.0)
  43. (setq INC1 (+ TXTHT2 (* TXTHT2 0.66))
  44.       INC INC1)
  45. (while (> TEST 0)
  46. (setq PT3 (polar PT2 RAD1 INC)
  47.       DESTXT2 (getstring T "\nEnter next description line: "))
  48. (command "TEXT" PT3 TXTHT2 0 DESTXT2)
  49. (if (= DESTXT2 "") (setq TEST 0) (setq INC (+ INC INC1))))
  50. (setvar "cmdecho" ECHO)
  51. (command)
  52. )
  53.