home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR038.ZIP / MENU-SYS.ARC / BALOON15.ORG < prev    next >
Lisp/Scheme  |  1987-08-01  |  7KB  |  169 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. ;          Balloon.LSP adds Detail Number "Balloons" to drawings
  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:BALLOON ()
  16. (setq ECHO (getvar "cmdecho") 
  17.       MODE (getvar "osmode") 
  18.       ORTHO (getvar "orthomode"))
  19. (setvar "orthomode" 0)
  20. (setvar "osmode" 0)
  21. (setvar  "cmdecho" 0)
  22. (command "GRAPHSCR")
  23. (setq RADV 57.29578
  24.       RAD1 (/ 90.0 RADV)
  25.       RAD2 (/ 180.0 RADV)
  26.       RAD3 (/ 270.0 RADV)
  27.       RAD4 0
  28.       PT1 (getpoint "\nEnter arrow start point: ")
  29.       CENPT (getpoint "\nEnter balloon center location: ")
  30.       RAD (angle PT1 CENPT) 
  31.       ARROW (getvar "dimasz") 
  32.       BALRAD 0.3125
  33.       PT2 (polar CENPT RAD (- 0 BALRAD)))
  34. (command "LINE" PT1 PT2 "")
  35. (setq END1 (+ RAD 0.2618)
  36.       END2 (- RAD 0.2618)
  37.       PT3 (polar PT1 END1 ARROW)
  38.       PT4 (polar PT1 END2 ARROW))
  39. (command "LINE" PT1 PT3 PT4 "C")
  40. (command "SOLID" PT1 PT3 PT4 PT4 "")
  41. (setq CENTPT (polar PT2 RAD BALRAD))
  42. (command "CIRCLE" CENTPT BALRAD)
  43. (setq VAR 0)
  44. (while (= VAR 0)
  45. (setq TMPNR (getreal "\nEnter the number of divisions 1 to 4 [1]: "))
  46. (if (= TMPNR nil) (setq TXTDIV 1.0) (setq TXTDIV TMPNR))
  47. (setq VAR TXTDIV)
  48. (if (/= TXTDIV 1.0) (progn
  49. (if (/= TXTDIV 2.0) (progn
  50. (if (/= TXTDIV 3.0) (progn
  51. (if (/= TXTDIV 4.0) (progn (setq VAR 0)
  52. (princ "Invalid Entry....Out of Range"))))))))))
  53. (if (= TXTDIV 1.0) (progn
  54. (setq TXTHT 0.25 
  55.       TXTLOC (list (- (car CENTPT) (* 0.268 (/ TXTHT 2.0))) (- (cadr CENTPT) (/ TXTHT 2.0)))
  56.       VAR1 0)
  57. (while (= VAR1 0)
  58. (setq BALTXT (getstring "\nEnter balloon text (2 char. max.): "))
  59. (if (> (strlen BALTXT) 2) (progn (setq VAR1 0)
  60. (princ "Invalid Entry....Too Many Charactors"))
  61. (setq VAR1 1)))
  62. (command "TEXT" "C" TXTLOC TXTHT 0 BALTXT)))
  63. (if (= TXTDIV 2.0) (progn
  64. (setq TXTHT1 0.2
  65.       TXTHT2 0.18
  66.       OSET1 (* 0.268 (/ TXTHT1 2.0))
  67.       OSET2 (* 0.268 (/ TXTHT2 2.0))
  68.       TXTLOC1 (list (- (car CENTPT) OSET1) (+ (cadr CENTPT) 0.04))
  69.       TXTLOC2 (list (- (car CENTPT) OSET2) (- (cadr CENTPT) (+ TXTHT2 0.04)))
  70.       PT5 (polar CENTPT RAD2 BALRAD)
  71.       PT6 (polar CENTPT RAD4 BALRAD))
  72. (command "LINE" PT5 PT6 "")
  73. (setq VAR2 0)
  74. (while (= VAR2 0)
  75. (setq UPTXT (getstring "\nEnter upper text (2 char. max.): "))
  76. (if (> (strlen UPTXT) 2) (progn (setq VAR2 0)
  77. (princ "Invalid Entry....Too Many Charactors")) (progn
  78. (setq VAR2 1)
  79. (command "TEXT" "C" TXTLOC1 TXTHT1 0 UPTXT))))
  80. (setq VAR2 0)
  81. (while (= VAR2 0)
  82. (setq LOWTXT (getstring "\nEnter lower text (2 char. max.): "))
  83. (if (> (strlen LOWTXT) 2) (progn (setq VAR2 0)
  84. (princ "Invalid Entry....Too Many Charactors")) (progn
  85. (setq VAR2 1)
  86. (command "TEXT" "C" TXTLOC2 TXTHT2 0 LOWTXT))))))
  87. (if (= TXTDIV 3.0) (progn
  88. (setq TXTHT1 0.2
  89.       TXTHT2 0.18
  90.       OSET1 (* 0.268 (/ TXTHT1 2.0))
  91.       OSET2 (* 0.268 (/ TXTHT2 2.0))
  92.       TXTLOC1 (list (- (car CENTPT) OSET1) (+ (cadr CENTPT) 0.04))
  93.       TXTLOC2 (list (- (car CENTPT) (+ OSET2 0.12)) (- (cadr CENTPT) (+ TXTHT2 0.04)))
  94.       TXTLOC3 (list (+ (car CENTPT) (- 0.12 OSET2)) (- (cadr CENTPT) (+ TXTHT2 0.04)))
  95.       PT5 (polar CENTPT RAD2 BALRAD)
  96.       PT6 (polar CENTPT RAD4 BALRAD)
  97.       PT7 (polar CENTPT RAD3 BALRAD))
  98. (command "LINE" PT5 PT6 "")
  99. (command "LINE" CENTPT PT7 "")
  100. (setq VAR3 0)
  101. (while (= VAR3 0)
  102. (setq UPTXT (getstring "\nEnter upper text (2 char. max.): "))
  103. (if (> (strlen UPTXT) 2) (progn (setq VAR3 0)
  104. (princ "Invalid Entry....Too Many Charactors")) (progn
  105. (setq VAR3 1)
  106. (command "TEXT" "C" TXTLOC1 TXTHT1 0 UPTXT))))
  107. (setq VAR3 0)
  108. (while (= VAR3 0)
  109. (setq LLTXT (getstring "\nEnter lower left text (1 char. max.): "))
  110. (if (> (strlen LLTXT) 1) (progn (setq VAR3 0)
  111. (princ "Invalid Entry....Too Many Charactors")) (progn
  112. (setq VAR3 1)
  113. (command "TEXT" "C" TXTLOC2 TXTHT2 0 LLTXT))))
  114. (setq VAR3 0)
  115. (while (= VAR3 0)
  116. (setq LRTXT (getstring "\nEnter lower right text (1 char. max.): "))
  117. (if (> (strlen LRTXT) 1) (progn (setq VAR3 0)
  118. (princ "Invalid Entry....Too Many Charactors")) (progn
  119. (setq VAR3 1)
  120. (command "TEXT" "C" TXTLOC3 TXTHT2 0 LRTXT))))))
  121. (if (= TXTDIV 4.0) (progn
  122. (setq TXTHT1 0.19
  123.       TXTHT2 0.17
  124.       OSET1 (* 0.268 (/ TXTHT1 2.0))
  125.       OSET2 (* 0.268 (/ TXTHT2 2.0))
  126.       TXTLOC1 (list (- (car CENTPT) (+ 0.12 OSET1)) (+ (cadr CENTPT) 0.045))
  127.       TXTLOC2 (list (+ (car CENTPT) (- 0.12 OSET1)) (+ (cadr CENTPT) 0.045))
  128.       TXTLOC3 (list (- (car CENTPT) (+ 0.12 OSET2)) (- (cadr CENTPT) (+ TXTHT2 0.045)))
  129.       TXTLOC4 (list (+ (car CENTPT) (- 0.12 OSET2)) (- (cadr CENTPT) (+ TXTHT2 0.045)))
  130.       PT5 (polar CENTPT RAD2 BALRAD)
  131.       PT6 (polar CENTPT RAD4 BALRAD)
  132.       PT7 (polar CENTPT RAD1 BALRAD)
  133.       PT8 (polar CENTPT RAD3 BALRAD))
  134. (command "LINE" PT5 PT6 "")
  135. (command "LINE" PT7 PT8 "")
  136. (setq VAR4 0)
  137. (while (= VAR4 0)
  138. (setq ULTXT (getstring "\nEnter upper left text (1 char. max.): "))
  139. (if (> (strlen ULTXT) 1) (progn (setq VAR4 0)
  140. (princ "Invalid Entry....Too Many Charactors")) (progn
  141. (setq VAR4 1)
  142. (command "TEXT" "C" TXTLOC1 TXTHT1 0 ULTXT))))
  143. (setq VAR4 0)
  144. (while (= VAR4 0)
  145. (setq URTXT (getstring "\nEnter upper right text (1 char. max.): "))
  146. (if (> (strlen URTXT) 1) (progn (setq VAR4 0)
  147. (princ "Invalid Entry....Too Many Charactors")) (progn
  148. (setq VAR4 1)
  149. (command "TEXT" "C" TXTLOC2 TXTHT1 0 URTXT))))
  150. (setq VAR4 0)
  151. (while (= VAR4 0)
  152. (setq LLTXT (getstring "\nEnter lower left text (1 char. max.): "))
  153. (if (> (strlen LLTXT) 1) (progn (setq VAR4 0)
  154. (princ "Invalid Entry....Too Many Charactors")) (progn
  155. (setq VAR4 1)
  156. (command "TEXT" "C" TXTLOC3 TXTHT2 0 LLTXT))))
  157. (setq VAR4 0)
  158. (while (= VAR4 0)
  159. (setq LRTXT (getstring "\nEnter lower right text (1 char. max.): "))
  160. (if (> (strlen LRTXT) 1) (progn (setq VAR4 0)
  161. (princ "Invalid Entry....Too Many Charactors")) (progn
  162. (setq VAR4 1)
  163. (command "TEXT" "C" TXTLOC4 TXTHT2 0 LRTXT))))))
  164. (setvar "osmode" MODE)
  165. (setvar "cmdecho" ECHO)
  166. (setvar "orthomode" ORTHO)
  167. (command)
  168. )
  169.