;BUBBA.LSP
;This will insert an item callout to the proper scale using dimscale.
;on the DIM layer with the text green FOR RELEASE 13 and 14 ONLY.
;
;Written by: S. Restmeyer  12/28/95
;
;  Anmerkung:   Grüne Textfarbe und Layer "DIM" sind außer Funktion!
;               (31.10.2002 / Zichy)
;  Erweiterung: (31.10.2002 / Zichy)
;               Die Ballons werden mit Nummern gefüllt, die automatisch
;               um jeweils 1 erhöht werden und in der Benutzervariablen
;               USERI5 abgelegt werden. Umbenennung der Funktion auf 
;               "Autonote".
;               19.11.2004: Kommandos internationalisiert; Prompts auf deutsch
;
;;;---------------------Begrüßung (Autor: Sebastian Zichy)---------
(princ "\nBUBBA_AUTO.LSP geladen.")
(princ "\nZeichnet Führungslinien mit automatisch erhöhten Nummern.")
(princ "\nVerwendet die Systemvariablen USERI5 (aktuelle Nr.), ")
(princ "USERR1 (Durchmesser), USERR2 (Texthöhe)")
(princ "\nAufruf mit \"AUTONOTE\"")
;
;;;----------------------ERROR FUNCTION----------------------------
;;;
(DEFUN ERR (S)
   ;if an error (such as CTRL-C) occurs while this command is active...
   (if (not (member s '("console break" "Function cancelled")))
      (princ (strcat "\nError: " s))
   )
   (command "_.UNDO" "_E")     ;end any outstanding UNDO group
   (setvar "cmdecho" cmd)      ;restore saved mode
   (setvar "orthomode" om)
   (setvar "highlight" hl)
   (setvar "textsize" ts)
   (setvar "aperture" as)
   (setvar "osmode" osm)
   (setvar "snapunit" su)
   (setvar "snapmode" sm)
   (setvar "pickbox" pb)
;   (setvar "clayer" lr)
   (setvar "dimtxt" dt)
   (setq *error* olderr)       ;restore old *error* handler
   (princ)
)
;;;------------------------MAIN PROGRAM----------------------------
;;;
(DEFUN C:AUTONOTE (/ SSET CMD DT DS TS ITS SM OM AS HL OSM LR APT BPT CPT TX;+
ANG SU CD PB BD EN OLDERR ANS)
(setq olderr *error* *error* err)
(SETQ CMD (GETVAR "CMDECHO"))
(setq pb (getvar "pickbox"))
(setq as (getvar "aperture"))
(setq su (getvar "snapunit"))
(setq ts (getvar "textsize"))
(setq hl (getvar "highlight"))
(setq sm (getvar "snapmode"))
(setq om (getvar "orthomode"))
(setq dt (getvar "dimtxt"))
;(setq lr (getvar "clayer"))
(setq osm (getvar "osmode"))
  (command "_.UNDO" "_g")
  (setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setvar "highlight" 0)
(if (= (getvar "dimscale") 0)
   (setq ds 1)
   (setq ds (getvar "dimscale"))
)
(setvar "osmode" 512)
  (if (or (> (getvar "userr1") 0) (> (getvar "userr2") 0))
    (progn
  (setq ans (strcase (getstring "\n<R>eset oder <Enter> um fortzusetzen> ")))
   (if (= ans "R")
     (progn
       (setvar "userr1" 0)
       (setvar "userr2" 0)
     )
   )
  )
    )
  (setq cd (* (getvar "userr1") 2))
(if (= cd 0)
   (progn
      (setq cd (getreal "\nBallondurchmesser <ENTER für Auswahl> "))
      (if (not (null cd))
      (setq cd (* ds cd)))
      (if (null cd)
         (progn
            (setq cd (entsel))
            (while (null cd)
               (prompt "\ndaneben... nochmal versuchen...")
               (setq cd (entsel))
            )
            (setq cd (* (cdr (assoc 40 (entget (car cd)))) 2))
         )
      )
   )
)
(setvar "userr1" (/ cd 2))
(setq cd (getvar "userr1"))
(if (= (getvar "userr2") 0)
   (progn
      (setq its (getreal "\nTexthöhe der Numerierung <ENTER für Auswahl> "))
      (if (not (null its))
      (setq its (* ds its)))
      (if (null its)
         (progn
            (setq its (entsel))
            (while (null its)
               (prompt "\ndaneben... nochmal versuchen...")
               (setq its (entsel))
            )
            (setq its (cdr (assoc 40 (entget (car its)))))
         )
      )
      (setvar "userr2" its)
   ))
   (setvar "textsize" (getvar "userr2"))
   (if (> (getvar "dimtxt") (getvar "userr2"))
      (setvar "dimtxt" (getvar "userr2"))
      (setvar "dimtxt" (getvar "dimtxt"))
   )
;   (command "layer" "u" "*" "")
 ;  (command "layer" "m" "dim" "c" "1" "dim" "")
   (setvar "aperture" 3)
   (setq apt (getpoint "\nLage der Pfeilspitze wählen <ENTER wenn keine>: ")) (princ)
   (if (not (null apt))
      (progn
         (setvar "snapmode" 1)
         (setq bpt (getpoint apt "\nzweiten Punkt wählen: "))
         (grdraw apt bpt -1)
         (setvar "orthomode" 1)
         (SETVAR "OSMODE" 0)
         (command "_snap" (* (getvar "dimscale") 0.125))
         (setq cpt (getpoint bpt "\nEndpunkt wählen <ENTER wenn ohne Fähnchen>: "))
         (redraw)
         (if (not (null cpt)) ;+
            (progn
               (command "_leader" apt bpt cpt "" "" "_n")
               (if (< (car cpt) (car bpt)) (setq bpt (subst (- (car cpt) cd) (
               car bpt) bpt))
               (setq bpt (subst (+ (car cpt) cd) (car bpt) bpt)))
               (command "_circle" bpt cd)
            )
            (progn
               (setq ang (angle apt bpt))
               (setq ang (strcat "@" (rtos cd 2) "<" (angtos ang 0 10)))
               (command "_leader" apt bpt "" "" "_n")
               (command "_circle" "_from" bpt ang cd)
               (setq bpt (cdr (assoc 10 (entget (entlast)))))
            )
         )
         (command "_redraw")
      ))
      (if (null apt)
         (progn
            (setvar "osmode" 16)
            (setvar "pickbox" 2)
            (setq bpt (getpoint "\nSelect side of balloon to attach to: "))
            (setq sset (ssget bpt))
            (setq en (ssname sset 0))
            (setq en (entget en))
            (setq apt (cdr (assoc 10 en)))
            (if (< (car apt) (car bpt)) (setq bpt (subst (+ (car bpt) cd) (car
            bpt) bpt)))
            (if (> (car apt) (car bpt)) (setq bpt (subst (- (car bpt) cd) (car
            bpt) bpt)))
            (if (< (cadr apt) (cadr bpt)) (setq bpt (subst (+ (cadr bpt) cd) (
            cadr bpt) bpt)))
            (if (> (cadr apt) (cadr bpt)) (setq bpt (subst (- (cadr bpt) cd) (
            cadr bpt) bpt)))
            (command "circle" bpt cd)
         ))
         (setvar "osmode" 0)
;        Einfügung für automatische Item-No.:
         (setq tx (itoa (setvar "useri5" (1+ (getvar "useri5")))))
;         (SETQ tx (getstring "\nItem number > "))
         (command "_text" "_m" bpt (getvar "textsize") "0" tx)
         (if (> (strlen tx) 2)
            (progn
               (setq en (entget (entlast)))
               (setq en (subst (cons 41 0.75) (assoc 41 en) en))
               (entmod en)
            ))
 ;           (command "chprop" "l" "" "c" "green" "")
            (setq bd (/ (getvar "dimtxt") 3))
            (setq bd (+ (* ds bd) cd))
            (setq tx (getstring T "\nTextanmerkung <ENTER wenn keine>: "))
            (if (< (strlen tx) 0) (command "_redraw")
            (+ (strlen tx) 0))
            (if (> (strlen tx) 0)
               (progn
                  (initget 1 "R L O U")
                  (setq ans;+
                  (getkword "\nauf welche Ballonseite soll die Textanmerkung? (R/L/O/U) > "))
                  (cond;+
                     ((= ans "L") (command "text" "mr" (subst (- (car bpt) bd) (
                     car bpt) bpt);+
                     (* ds (getvar "dimtxt")) "0" tx));+
                     ((= ans "R") (command "_text" "_ml" (subst (+ (car bpt) bd) (
                     car bpt) bpt);+
                     (* ds (getvar "dimtxt")) "0" tx));+
                     ((= ans "O") (command "_text" "_bc" (subst (+ (cadr bpt) bd)
                     (cadr bpt) bpt);+
                     (* ds (getvar "dimtxt")) "0" tx));+
                     ((= ans "U") (command "_text" "_tc" (subst (- (cadr bpt) bd)
                     (cadr bpt) bpt);+
                     (* ds (getvar "dimtxt")) "0" tx));+
                  )));
     ;             (command "chprop" "l" "" "c" "green" "")
      ;            (setvar "clayer" lr)
                  (setvar "highlight" hl)
                  (setvar "osmode" osm)
                  (setvar "orthomode" om)
                  (setvar "pickbox" pb)
                  (setvar "snapunit" su)
                  (setvar "textsize" ts)
                  (setvar "snapmode" sm)
                  (setvar "aperture" as)
                  (setvar "dimtxt" dt)
                  (setvar "cmdecho" cmd)
                  (setq *error* olderr)
                  (princ)
               )