;; (c)1987                R&J Computer Service
;                            RR #3  Box 183
;                          Albion, IN  46701
;  Phone:                Voice  (219) 636-2460
;                         Data  (219) 636-3153
;                   24hrs 2400, 1200, 300 Baud 8-N-1
;          Balloon.LSP adds Detail Number "Balloons" to drawings
;                        Written by John Kitt
; We are NOT responsable for the performance or accuracy of this LISP routine
;  You are encouraged to copy and distribute this LISP routine
;  provided this header section IS NOT REMOVED.  For continued
;  support and new LISP routines you are asked to mail a Registration
;  fee of $10.00 to the above address.  Thank You!!!
;
;
;
;  Changes and Additional Code by Bob Thomas,
;                                 Thomas Enterprises, ltd.
;                                 628 Clement St.
;                                 San Francisco, CA  94118
;                                 (415) 751-3275
;
;                                 DATE: 2/26/88
;
;  Modified John's stuff to set up the balloon with a multi-segment leader,
;  and adjust the size of the balloon automatically, based on the "DIMASZ" 
;  (arrow size) dimension variable -- the bigger the dimension arrows, 
;  the bigger the balloon circle. Text is also automatically adjusted 
;  based on the size of the balloon circle. 
;
;  -- If you want, you can have many different balloon sizes in a drawing:
;  use the ACAD command SETVAR to change the value of DIMASZ. Transparent
;  'SETVAR will also work.
;
;  (Here's my plug --> I wrote a book: "Advanced Techniques in AutoCAD", 
;  published by Sybex, Inc... You can find it in most any bookstore that 
;  carries computer titles -- or call me, I'll be overjoyed to sell you 
;  a copy for $28.70 ($26.95 + 1.75 CA sales tax if you're in CA. Shipping
;  is included...))
;
(defun C:BALLOON ()
(setq lnpt1 nil)
(setq oldech (getvar "cmdecho") 
      oldmd (getvar "osmode") 
      oldoth (getvar "orthomode")
      oldblp (getvar "blipmode")
)
(setvar "orthomode" 0)
(setvar "osmode" 0)
(setvar  "cmdecho" 0)
(while (= lnpt1 nil)
       (setq lnpt1 (getpoint "\nEnter arrow start point: "))
)
(setq pt1 lnpt1
      angpt lnpt1)
(while (or (= lnpt2 nil) (= lnpt2 ""))
       (setq lnpt2 (getpoint pt1 "\nEnter next line point: "))
       (if (and (/= lnpt2 nil) (/= lnpt2 ""))
           (command "LINE" lnpt1 lnpt2 "")
       )
       (setq lstpt lnpt2
             lnpt1 lnpt2)
)
(setq cenpt lnpt2)
(while (and (/= lnpt1 nil) (/= lnpt1 ""))
       (setq lnpt2 (getpoint lnpt1 "\nEnter next line point (RETURN quits): "))
       (if (and (/= lnpt2 nil) (/= lnpt2 ""))
           (progn
                  (command "LINE" lnpt1 lnpt2 "")
                  (setq angpt lnpt1
                        lstpt lnpt2)
           )
       )
       (setq lnpt1 lnpt2)
)
(setq 
      ARROW (getvar "dimasz") 
      BALRAD (* ARROW 1.2)
      CENPT2 (polar lstpt (angle angpt lstpt) balrad)
      RADV 57.29578
      RAD1 (/ 90.0 RADV)
      RAD2 (/ 180.0 RADV)
      RAD3 (/ 270.0 RADV)
      RAD4 0
      RAD (angle PT1 CENPT) 
      PT2 (polar CENPT2 RAD (- 0 BALRAD))
      END1 (+ RAD 0.2618)
      END2 (- RAD 0.2618)
      PT3 (polar PT1 END1 ARROW)
      PT4 (polar PT1 END2 ARROW)
)
(setvar "blipmode" 0)
(command "SOLID" PT1 PT3 PT4 PT4 "")
(setq CENTPT (polar PT2 RAD BALRAD))
(command "CIRCLE" CENPT2 BALRAD)
(setq VAR 0)
(while (= VAR 0)
   (setq TMPNR (getreal "\nEnter the number of divisions 1 to 4 [1]: ")
   )
   (if (= TMPNR nil) 
       (setq TXTDIV 1.0) 
       (setq TXTDIV TMPNR)
   )
   (setq VAR TXTDIV)
   (if (/= TXTDIV 1.0) 
       (progn
            (if (/= TXTDIV 2.0) 
                (progn
                     (if (/= TXTDIV 3.0) 
                         (progn
                              (if (/= TXTDIV 4.0) 
                                  (progn 
                                       (setq VAR 0)
                                       (princ "Invalid Entry....Out of Range")
                                  )
                              )
                         )
                     )
                )
            )
       )
   )
)
(if (= TXTDIV 1.0) 
    (progn
         (setq TXTHT (* BALRAD 0.75)
               TXTLOC (list (car CENTPT) (- (cadr CENTPT) (/ TXTHT 2.0)))
               VAR1 0
         )
         (while (= VAR1 0)
                (setq BALTXT (getstring "\nEnter balloon text (2 char. max.): "))
                (if (> (strlen BALTXT) 2) 
                    (progn 
                         (setq VAR1 0)
                         (princ "Invalid Entry....Too Many Charactors")
                    )
                    (setq VAR1 1)
                )
         )
         (command "TEXT" "C" TXTLOC TXTHT 0 BALTXT)
    )
)
(if (= TXTDIV 2.0) 
    (progn
         (setq TXTHT1 (/ BALRAD 2.0)
               TXTLOC1 (list (car CENTPT) (+ (cadr CENTPT) (/ BALRAD 8.0)))
               TXTLOC2 (list (car CENTPT) (- (cadr CENTPT) (- BALRAD (/ BALRAD 3.3))))
               PT5 (polar CENTPT RAD2 BALRAD)
               PT6 (polar CENTPT RAD4 BALRAD)
         )
         (command "LINE" PT5 PT6 "")
         (setq VAR2 0)
         (while (= VAR2 0)
                (setq UPTXT (getstring "\nEnter upper text (2 char. max.): "))
                (if (> (strlen UPTXT) 2) 
                    (progn 
                         (setq VAR2 0)
                         (princ "Invalid Entry....Too Many Charactors")
                    ) 
                    (progn
                         (setq VAR2 1)
                         (command "TEXT" "C" TXTLOC1 TXTHT1 0 UPTXT)
                    )
                )
         )
         (setq VAR2 0)
         (while (= VAR2 0)
                (setq LOWTXT (getstring "\nEnter lower text (2 char. max.): "))
                (if (> (strlen LOWTXT) 2) 
                    (progn 
                         (setq VAR2 0)
                         (princ "Invalid Entry....Too Many Charactors")
                    ) 
                    (progn
                         (setq VAR2 1)
                         (command "TEXT" "C" TXTLOC2 TXTHT1 0 LOWTXT)
                    )
                )
         )
    )
)
(if (= TXTDIV 3.0) 
    (progn
         (setq TXTHT1 (/ BALRAD 2.0)
               TXTLOC1 (list (car CENTPT) (+ (cadr CENTPT) (/ BALRAD 8.0)))
               TXTLOC2 (list (- (car CENTPT) TXTHT1) (- (cadr CENTPT) (- BALRAD (/ BALRAD 3.3))))
               TXTLOC3 (list (+ (car CENTPT) (/ BALRAD 4.0)) (- (cadr CENTPT) (- BALRAD (/ BALRAD 3.3))))
               PT5 (polar CENTPT RAD2 BALRAD)
               PT6 (polar CENTPT RAD4 BALRAD)
               PT7 (polar CENTPT RAD3 BALRAD)
         )
         (command "LINE" PT5 PT6 "")
         (command "LINE" CENTPT PT7 "")
         (setq VAR3 0)
         (while (= VAR3 0)
                (setq UPTXT (getstring "\nEnter upper text (2 char. max.): "))
                (if (> (strlen UPTXT) 2) 
                    (progn 
                         (setq VAR3 0)
                         (princ "Invalid Entry....Too Many Charactors")
                    ) 
                    (progn
                         (setq VAR3 1)
                         (command "TEXT" "C" TXTLOC1 TXTHT1 0 UPTXT)
                    )
                )
         )
         (setq VAR3 0)
         (while (= VAR3 0)
                (setq LLTXT (getstring "\nEnter lower left text (1 char. max.): "))
                (if (> (strlen LLTXT) 1) 
                    (progn 
                         (setq VAR3 0)
                         (princ "Invalid Entry....Too Many Charactors")
                    ) 
                    (progn
                         (setq VAR3 1)
                         (command "TEXT" TXTLOC2 TXTHT1 0 LLTXT)
                    )
                )
         )
         (setq VAR3 0)
         (while (= VAR3 0)
                (setq LRTXT (getstring "\nEnter lower right text (1 char. max.): "))
                (if (> (strlen LRTXT) 1) 
                    (progn 
                         (setq VAR3 0)
                         (princ "Invalid Entry....Too Many Charactors")
                    ) 
                    (progn
                         (setq VAR3 1)
                         (command "TEXT" TXTLOC3 TXTHT1 0 LRTXT)
                    )
                )
          )
    )
)
(if (= TXTDIV 4.0) 
    (progn
         (setq TXTHT1 (/ BALRAD 2.0)
               TXTLOC1 (list (- (car CENTPT) TXTHT1) (+ (cadr CENTPT) (/ BALRAD 8.0)))
               TXTLOC2 (list (+ (car CENTPT) (/ BALRAD 4.0)) (+ (cadr CENTPT) (/ BALRAD 8.0)))
               TXTLOC3 (list (- (car CENTPT) TXTHT1) (- (cadr CENTPT) (- BALRAD (/ BALRAD 3.3))))
               TXTLOC4 (list (+ (car CENTPT) (/ BALRAD 4.0)) (- (cadr CENTPT) (- BALRAD (/ BALRAD 3.3))))
               PT5 (polar CENTPT RAD2 BALRAD)
               PT6 (polar CENTPT RAD4 BALRAD)
               PT7 (polar CENTPT RAD1 BALRAD)
               PT8 (polar CENTPT RAD3 BALRAD)
         )
         (command "LINE" PT5 PT6 "")
         (command "LINE" PT7 PT8 "")
         (setq VAR4 0)
         (while (= VAR4 0)
                (setq ULTXT (getstring "\nEnter upper left text (1 char. max.): "))
                (if (> (strlen ULTXT) 1) 
                    (progn 
                         (setq VAR4 0)
                         (princ "Invalid Entry....Too Many Charactors")
                    ) 
                    (progn
                         (setq VAR4 1)
                         (command "TEXT" TXTLOC1 TXTHT1 0 ULTXT)
                    )
                 )
          )
          (setq VAR4 0)
          (while (= VAR4 0)
                 (setq URTXT (getstring "\nEnter upper right text (1 char. max.): "))
                 (if (> (strlen URTXT) 1) 
                     (progn 
                          (setq VAR4 0)
                          (princ "Invalid Entry....Too Many Charactors")
                     ) 
                     (progn
                          (setq VAR4 1)
                          (command "TEXT" TXTLOC2 TXTHT1 0 URTXT)
                     )
                 )
          )
          (setq VAR4 0)
          (while (= VAR4 0)
                 (setq LLTXT (getstring "\nEnter lower left text (1 char. max.): "))
                 (if (> (strlen LLTXT) 1) 
                     (progn 
                          (setq VAR4 0)
                          (princ "Invalid Entry....Too Many Charactors")
                     ) 
                     (progn
                          (setq VAR4 1)
                          (command "TEXT" TXTLOC3 TXTHT1 0 LLTXT)
                     )
                 )
          )
          (setq VAR4 0)
          (while (= VAR4 0)
                 (setq LRTXT (getstring "\nEnter lower right text (1 char. max.): "))
                 (if (> (strlen LRTXT) 1) 
                     (progn 
                          (setq VAR4 0)
                          (princ "Invalid Entry....Too Many Charactors")
                     ) 
                     (progn
                          (setq VAR4 1)
                          (command "TEXT" TXTLOC4 TXTHT1 0 LRTXT)
                     )
                 )
          )
    )
)
(setvar "osmode" oldmd)
(setvar "cmdecho" oldech)
(setvar "orthomode" oldoth)
(setvar "blipmode" oldblp)
(princ)
)