Bubble Note

Here is a great routine I have been playing around with. I need help
in the RECTANGLEBOX function I added. I want the arrow leader
tail to connect with the rectangular box....the way it is now, there is
a gap or overlap.

Gary



;;; BUB-NOTE.LSP BUBBLE NOTE (c) 2003 Ray Burnstad $50 Bonus Winner
;;; Ray Burnstad

;;; Bubble note error function

(defun bub_note_buberr (msg)
(if OE (setq *ERROR* OE))
(if BM (setvar "BLIPMODE" BM))
(if OSM (setvar "OSMODE" OSM))
(if SM (setvar "SNAPMODE" SM))
msg
)

;;; Main function

(defun BNOTIT (/ SS TXTLIM LL UR MP NX NY P1 SB NIC SSET TMP)
;;(ARCH:F_S-VAR)
(setvar "OSMODE" 0)
;;(ARCH:CUSTOM_LAYERS-SYMB)
(setq SSET (ssadd))
(princ "\n* Select all text to be included in (Bubble Outline) *")
(setq SS (ssget '((-4 . "<OR")(0 . "TEXT")(0 . "MTEXT")(-4 . "OR>"))))
(if SS (progn
(setvar "CMDECHO" 0)
(setq BM (getvar "BLIPMODE")
SM (getvar "SNAPMODE")
OSM (getvar "OSMODE")
OE *ERROR* *ERROR* bub_note_buberr
TXTLIM (bub_note_txt_lim SS)
LL (car TXTLIM)
UR (cadr TXTLIM)
MP (polar LL (angle LL UR) (/(distance LL UR)2))
LC (caddr TXTLIM)
NX (fix(-(/(-(car UR)(car LL))LC)0.5))
NY (fix(-(/(-(cadr UR)(cadr LL))LC)0.5))
LL (list (-(car MP)(/(*(1+ NX)LC)2))
(-(cadr MP)(/(*(1+ NY)LC)2)))
SP (list (-(car MP)(/(* NX LC)2))
(+(cadr MP)(/(*(+ NY 2)LC)2)))
)
(setq PLST (list LL) P1 LL)
(repeat (1+ NX) (setq P1 (polar P1 0 LC) PLST (cons P1 PLST)))
(repeat (1+ NY) (setq P1 (polar P1(* 0.5 pi)LC) PLST (cons P1 PLST)))
(repeat (1+ NX) (setq P1 (polar P1 pi LC) PLST (cons P1 PLST)))
(repeat NY (setq P1 (polar P1 (* 1.5 pi) LC) PLST (cons P1 PLST)))
(setvar "BLIPMODE" 0)
(setvar "SNAPMODE" 0)

(defun CLOUDBOX ()
(setvar "CMDECHO" 0)
(command "PLINE" SP "A")
(bub_note_drawbub 0 NX)
(bub_note_drawbub 270 NY)
(bub_note_drawbub 180 NX)
(bub_note_drawbub 90 NY)
(command "")
(princ)
)
(defun RECTANGLEBOX (/ XDIS)
(setvar "CMDECHO" 0)
;;(command "rectangle" (list XMIN YMIN)(list XMAX YMAX))
(setq XDIS (* (getvar "textsize")1.0))
(command "rectangle" (list (- (car LL)XDIS)(- (cadr LL)XDIS))(list (+ (car
UR)XDIS)(+ (cadr UR)XDIS)))
(command "pedit" "l" "w" (* XDIS 0.125) "")
(princ)
)

(initget "C R")
(setq tmp
(getkword
"\n* Select Box Type: <C>loud <R>ectangle *"
)
)
(cond
((= tmp "C")(CLOUDBOX))
((or (= tmp "R")(= tmp nil))(RECTANGLEBOX))
)

(setq SSET (ssadd (entlast) SSET))
(setvar "BLIPMODE" BM)
(setvar "OSMODE" OSM)
(setvar "CMDECHO" 0)
(if (setq P1 (bub_note_get_point))
(progn
(command "SOLID" (nth 1 VECS) (nth 2 VECS) (nth 5 VECS) "" "")
;;(command "PLINE" (nth 1 VECS) (nth 2 VECS) (nth 5 VECS) "" "")
(setq SSET (ssadd (entlast) SSET))
(command "LINE" (nth 10 VECS) (polar (nth 11 VECS)
(angle(nth 11 VECS)(nth 10 VECS)) (/ LC(sqrt 2))) "")
(setq SSET (ssadd (entlast) SSET))
(ARCH:RAND*NO)
(setq NIC (strcat "BUB-" *NO))
(command "-group" "" (princ NIC) "" (princ SSET) "")
(princ)
)
)
(setvar "SNAPMODE" SM)
(setvar "CMDECHO" 1)
(setq *ERROR* OE)
)
)
(setvar "CMDECHO" 1)
;;(ARCH:F_R-VAR)
(princ)
)

;;; Draws bubble border polyline

(defun bub_note_drawbub (A N / DI)
(setq DI (/(* A pi)180) A (+ A 45) SP (polar SP DI LC))
(repeat N (command "D" A SP) (setq SP (polar SP DI LC)))
(setq SP (polar SP (- DI(/ pi 2)) LC))
(command "D" A SP)
)

;;; Dymanically draws arrowhead while user picks point

(defun bub_note_get_point ( / DONE IP SOURCE CP)
(setq VECS nil)
(princ "\n* Pick Arrow Point (Return for none) *")
(while (not DONE)
(setq IP (grread 'T 4 1)
SOURCE (car IP)
CP (cadr IP))
(if VECS (grvecs VECS))
(cond((= SOURCE 2) ; if keyboard
(cond((= CP 2) (if (=(getvar "SNAPMODE")0) ; F9
(setvar "SNAPMODE" 1)
(setvar "SNAPMODE" 0)))
((= CP 4) (if (=(getvar "COORDS")0) ; F6
(setvar "COORDS" 1)
(setvar "COORDS" 0)))
((or(= CP 13)(= CP 32)) ; Enter or Space Bar
(grvecs VECS)
(setq DONE T CP nil))
)
(grvecs VECS)
)
((= SOURCE 3)(setq DONE T)) ; if pick point
((= SOURCE 5)(grvecs(setq VECS(bub_note_calc_ah CP)))) ; if drag
((and(= SOURCE 6)(= CP 0)) ; 2 button
(return)
(setq DONE T CP nil))
)
)
CP
)

;;; Calculate arrow head vectors

(defun bub_note_calc_ah (P / A B ANG P1 P2 P3 VL)
(setq A (nth 0 PLST) B (distance A P) N 1)
(repeat (1-(length PLST))
(if (<(distance(nth N PLST)P)B)
(setq A (nth N PLST) B (distance A P)))
(setq N (1+ N))
)
(setq ANG (angle P A)
P1 (polar P ANG LC)
P2 (polar P1 (+ ANG(/ pi 2)) (/ LC 6))
P3 (polar P1 (- ANG(/ pi 2)) (/ LC 6))
VL (list 257 P2 P 257 P P3 257 P2 P3 257 P1 A)
)
)

;;; Returns limits of bounding box and maximum text height

(defun bub_note_txt_lim (SS / ELST X Y H XMIN XMAX YMIN YMAX N P0 P1 P2 P3 P4
ANG SINROT COSROT T1 T2)
(setq ELST (entget(ssname SS 0)))
(cond
((=(cdr(assoc 0 ELST))"TEXT")
(setq X (cadr (assoc 10 ELST))
Y (caddr(assoc 10 ELST))
H (*(cdr (assoc 40 ELST))1.5)
XMIN X XMAX X YMIN Y YMAX Y
N 0)
(repeat (sslength SS)
(setq ELST (entget(ssname SS N))
P0 (cdr(assoc 10 ELST))
ANG (cdr(assoc 50 ELST))
SINROT (sin ANG)
COSROT (cos ANG)
T1 (car (textbox ELST))
T2 (cadr(textbox ELST))
P1 (list (+(car P0)(-(*(car T1)COSROT)(*(cadr T1)SINROT)))
(+(cadr P0)(+(*(car T1)SINROT)(*(cadr T1)COSROT))))
P2 (list (+(car P0)(-(*(car T2)COSROT)(*(cadr T1)SINROT)))
(+(cadr P0)(+(*(car T2)SINROT)(*(cadr T1)COSROT))))
P3 (list (+(car P0)(-(*(car T2)COSROT)(*(cadr T2)SINROT)))
(+(cadr P0)(+(*(car T2)SINROT)(*(cadr T2)COSROT))))
P4 (list (+(car P0)(-(*(car T1)COSROT)(*(cadr T2)SINROT)))
(+(cadr P0)(+(*(car T1)SINROT)(*(cadr T2)COSROT))))
)
(if (<(car P1)XMIN) (setq XMIN (car P1)))
(if (>(car P1)XMAX) (setq XMAX (car P1)))
(if (<(cadr P1)YMIN) (setq YMIN (cadr P1)))
(if (>(cadr P1)YMAX) (setq YMAX (cadr P1)))
(if (<(car P2)XMIN) (setq XMIN (car P2)))
(if (>(car P2)XMAX) (setq XMAX (car P2)))
(if (<(cadr P2)YMIN) (setq YMIN (cadr P2)))
(if (>(cadr P2)YMAX) (setq YMAX (cadr P2)))
(if (<(car P3)XMIN) (setq XMIN (car P3)))
(if (>(car P3)XMAX) (setq XMAX (car P3)))
(if (<(cadr P3)YMIN) (setq YMIN (cadr P3)))
(if (>(cadr P3)YMAX) (setq YMAX (cadr P3)))
(if (<(car P4)XMIN) (setq XMIN (car P4)))
(if (>(car P4)XMAX) (setq XMAX (car P4)))
(if (<(cadr P4)YMIN) (setq YMIN (cadr P4)))
(if (>(cadr P4)YMAX) (setq YMAX (cadr P4)))
(if (>(cdr(assoc 40 ELST))H) (setq H (cdr(assoc 40 ELST))))
(setq N (1+ N))
)
)
((=(cdr(assoc 0 ELST))"MTEXT")
(setq P1 (cdr(assoc 10 ELST)) ;
Upper Left
P2 (polar P1 (cdr(assoc 50 ELST)) (cdr(assoc 42 ELST))) ;
Upper Right
P3 (polar P2 (-(cdr(assoc 50 ELST))(/ pi 2)) (cdr(assoc 43 ELST))) ;
Lower Right
P4 (polar P1 (-(cdr(assoc 50 ELST))(/ pi 2)) (cdr(assoc 43 ELST))) ;
Lower Left
XMIN (cadr(assoc 10 ELST))
YMAX (caddr(assoc 10 ELST))
XMAX XMIN
YMIN YMAX
H (*(cdr (assoc 40 ELST))1.5)
)
(if (<(car P2)XMIN) (setq XMIN (car P2)))
(if (>(car P2)XMAX) (setq XMAX (car P2)))
(if (<(cadr P2)YMIN) (setq YMIN (cadr P2)))
(if (>(cadr P2)YMAX) (setq YMAX (cadr P2)))
(if (<(car P3)XMIN) (setq XMIN (car P3)))
(if (>(car P3)XMAX) (setq XMAX (car P3)))
(if (<(cadr P3)YMIN) (setq YMIN (cadr P3)))
(if (>(cadr P3)YMAX) (setq YMAX (cadr P3)))
(if (<(car P4)XMIN) (setq XMIN (car P4)))
(if (>(car P4)XMAX) (setq XMAX (car P4)))
(if (<(cadr P4)YMIN) (setq YMIN (cadr P4)))
(if (>(cadr P4)YMAX) (setq YMAX (cadr P4)))
)
)
(list (list XMIN YMIN) (list XMAX YMAX) H)
)

 

Neat routine.
The quick fix is to add "_nea" to the LINE command
also this
(setq ss (ssget '((-4 . "<OR") (0 . "TEXT") (0 . "MTEXT") (-4 . "OR>"))))
could be
(setq ss (ssget '((0 . "TEXT,MTEXT"))))


Hope you don't mind I replaced your bounding box code.

;;; BUB-NOTE.LSP BUBBLE NOTE (c) 2003 Ray Burnstad $50 Bonus Winner
;;; Ray Burnstad

;;; Bubble note error function

(defun bub_note_buberr (msg)
(if oe
(setq *error* oe)
)
(if bm
(setvar "BLIPMODE" bm)
)
(if osm
(setvar "OSMODE" osm)
)
(if sm
(setvar "SNAPMODE" sm)
)
msg
)


;;-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
;; M a i n f u n c t i o n
;;-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+

(defun bnotit (/ ss txtlim ll ur mp nx ny p1 sb nic sset tmp)
(princ "\n* Select all text to be included in (Bubble Outline) *")
(if (not (setq ss (ssget '((0 . "TEXT,MTEXT")))))
(exit)
)
;;(ARCH:F_S-VAR)
(setvar "OSMODE" 0)
;;(ARCH:CUSTOM_LAYERS-SYMB)
(setq sset (ssadd))
(setvar "CMDECHO" 0)
;; CAB added
(setq lc (*(cdr (assoc 40 (entget(ssname SS 0))))1.5))
;;
(setq bm (getvar "BLIPMODE")
sm (getvar "SNAPMODE")
osm (getvar "OSMODE")
oe *error*
*error* bub_note_buberr
txtlim (bounds)
ll (car txtlim)
ur (cadr txtlim)
mp (polar ll (angle ll ur) (/ (distance ll ur) 2))
;; lc (caddr txtlim) ; CAB removed
nx (fix (- (/ (- (car ur) (car ll)) lc) 0.5))
ny (fix (- (/ (- (cadr ur) (cadr ll)) lc) 0.5))
ll (list (- (car mp) (/ (* (1+ nx) lc) 2))
(- (cadr mp) (/ (* (1+ ny) lc) 2))
)
sp (list (- (car mp) (/ (* nx lc) 2))
(+ (cadr mp) (/ (* (+ ny 2) lc) 2))
)
)
(setq plst (list ll)
p1 ll
)
(repeat (1+ nx)
(setq p1 (polar p1 0 lc)
plst (cons p1 plst)
)
)
(repeat (1+ ny)
(setq p1 (polar p1 (* 0.5 pi) lc)
plst (cons p1 plst)
)
)
(repeat (1+ nx)
(setq p1 (polar p1 pi lc)
plst (cons p1 plst)
)
)
(repeat ny
(setq p1 (polar p1 (* 1.5 pi) lc)
plst (cons p1 plst)
)
)
(setvar "BLIPMODE" 0)
(setvar "SNAPMODE" 0)

(initget "C R")
(setq tmp
(getkword
"\n* Select Box Type: <C>loud <R>ectangle *"
)
)
(cond
((= tmp "C") (cloudbox))
((or (= tmp "R") (= tmp nil)) (rectanglebox))
)

(setq sset (ssadd (entlast) sset))
(setvar "BLIPMODE" bm)
(setvar "OSMODE" osm)
(setvar "CMDECHO" 0)
(if (setq p1 (bub_note_get_point))
(progn
(command "SOLID" (nth 1 vecs) (nth 2 vecs) (nth 5 vecs) "" "")
;;(command "PLINE" (nth 1 VECS) (nth 2 VECS) (nth 5 VECS) "" "")
(setq sset (ssadd (entlast) sset))
(command "LINE"
(nth 10 vecs)
"_nea"
(polar (nth 11 vecs)
(angle (nth 11 vecs) (nth 10 vecs))
(/ lc (sqrt 2))
)
""
)
(setq sset (ssadd (entlast) sset))
;;(arch:rand*no)
;;(setq nic (strcat "BUB-" *no))
;;(command "-group" "" (princ nic) "" (princ sset) "")
(princ)
)
)

(setvar "SNAPMODE" sm)
(setvar "CMDECHO" 1)
(setq *error* oe)
;;(ARCH:F_R-VAR)
(princ)
)
;;-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
;; E N D O F M A I N R O U T I N E
;;-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+


;;------------------------------------------------------------
(defun cloudbox ()
(setvar "CMDECHO" 0)
(command "PLINE" sp "A")
(bub_note_drawbub 0 nx)
(bub_note_drawbub 270 ny)
(bub_note_drawbub 180 nx)
(bub_note_drawbub 90 ny)
(command "")
(princ)
)

;;------------------------------------------------------------
(defun rectanglebox (/ xdis)
(setvar "CMDECHO" 0)
;;(command "rectangle" (list XMIN YMIN)(list XMAX YMAX))
(setq xdis (* (getvar "textsize") 1.0))
(command "rectangle"
(list (- (car ll) xdis) (- (cadr ll) xdis))
(list (+ (car
ur
)
xdis
)
(+ (cadr ur) xdis)
)
)
(command "pedit" "l" "w" (* xdis 0.125) "")
(princ)
)

;;------------------------------------------------------------
;; Draws bubble border polyline
(defun bub_note_drawbub (a n / di)
(setq di (/ (* a pi) 180)
a (+ a 45)
sp (polar sp di lc)
)
(repeat n (command "D" a sp) (setq sp (polar sp di lc)))
(setq sp (polar sp (- di (/ pi 2)) lc))
(command "D" a sp)
)

;;------------------------------------------------------------
;; Dymanically draws arrowhead while user picks point
(defun bub_note_get_point (/ done ip source cp)
(setq vecs nil)
(princ "\n* Pick Arrow Point (Return for none) *")
(while (not done)
(setq ip (grread 't 4 1)
source (car ip)
cp (cadr ip)
)
(if vecs
(grvecs vecs)
)
(cond ((= source 2) ; if keyboard
(cond ((= cp 2)
(if (= (getvar "SNAPMODE") 0) ; F9
(setvar "SNAPMODE" 1)
(setvar "SNAPMODE" 0)
)
)
((= cp 4)
(if (= (getvar "COORDS") 0) ; F6
(setvar "COORDS" 1)
(setvar "COORDS" 0)
)
)
((or (= cp 13) (= cp 32)) ; Enter or Space Bar
(grvecs vecs)
(setq done t
cp nil
)
)
)
(grvecs vecs)
)
((= source 3) (setq done t)) ; if pick point
((= source 5) (grvecs (setq vecs (bub_note_calc_ah cp)))) ; if drag
((and (= source 6) (= cp 0)) ; 2 button
(return)
(setq done t
cp nil
)
)
)
)
cp
)

;;------------------------------------------------------------
;; Calculate arrow head vectors
(defun bub_note_calc_ah (p / a b ang p1 p2 p3 vl)
(setq a (nth 0 plst)
b (distance a p)
n 1
)
(repeat (1- (length plst))
(if (< (distance (nth n plst) p) b)
(setq a (nth n plst)
b (distance a p)
)
)
(setq n (1+ n))
)
(setq ang (angle p a)
p1 (polar p ang lc)
p2 (polar p1 (+ ang (/ pi 2)) (/ lc 6))
p3 (polar p1 (- ang (/ pi 2)) (/ lc 6))
vl (list 257 p2 p 257 p p3 257 p2 p3 257 p1 a)
)
)

;;------------------------------------------------------------
;; Returns limits of bounding box and maximum text height
(defun bounds (/ llc urc ll ur ss doc bad limits avp)
;;c. 07-10-03
;;D. C. Broad, Jr. Demonstration for bounds selection
;;Returns the bounds of a selection set
;;Modified (07-12-03) by John Uhden to look for failures
;; Modified by CAB for use in this routine
(and
(vl-load-com)
(setq bad 0)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
;|(setq avp (vla-get-activepviewport doc))
(ssget
(list
(cons 410
(if (= (getvar "cvport") 1)
(getvar "ctab")
"Model"
)
)
)
)|;
(or
(setq ss (vla-get-activeselectionset doc))
(prompt "\nFailed to get ActiveSelectionSet")
)
(vlax-for n ss
(setq ll nil ur nil)
(vl-catch-all-apply
'vla-getboundingbox
(list n 'll 'ur)
)
(cond
;;((equal n avp))
((not (and ll ur))(setq bad (1+ bad)))
(llc
(setq llc (mapcar 'min llc (vlax-safearray->list ll)))
(setq urc (mapcar 'max urc (vlax-safearray->list ur)))
)
(1
(setq llc (vlax-safearray->list ll))
(setq urc (vlax-safearray->list ur))
)
)
)
(or
(= bad 0)
(princ (strcat "\nFailed to get " (itoa bad) " object boundaries"))
)
llc
urc
(setq limits (list llc urc))
)
limits
)

 

Thanks for the help...works great now.
I left out the function below.

I like to make the annotation box and arrow into a group....
;;;;;;;;;;;;;;;;;;;;;;;;;;; Raddom Generator Number
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:RAND*NO ()
(setq *NO (rtos (getvar "CDATE") 2 16)
*NO (substr *NO 14 3)
;;3
)
(princ))

Thanks again...Happy New Year

Thanks for your bounds function.

Gary