Lisp Modification for Text

[GBarfield]

We have a list routine that draws a vertical line in front of text. This will NOT work with the Autocad Leader command b/c it isn't text or mtext. Could someone take a look at this routine and see if it can be modified to work w/ the leader routine? Below is the lisp routine that we currently use.


(defun C:TL (/ E1 ED EN PT1 PT2 PT4 ANG1 ANG2 ITEMS OFFSET OFFSET1
i LENGTH2 LENGTH1 ANG HEIGHT LL OBJ SAVE UR)
(SETQ SAVE (GETVAR "CECOLOR"))
(SETVAR "CECOLOR" "15")
;(SETQ OFFSET1 (/ (GETVAR "TEXTSIZE") 2)) Moved into subs to adjust for
actual
;(SETQ OFFSET (/ (GETVAR "TEXTSIZE") 3)) text size of selected object
(SETQ ITEMS (SSGET '((0 . "TEXT,MTEXT")))); revised to only get text
objects
(SETQ i (SSLENGTH ITEMS))
(WHILE (> i 0)
(SETQ i (1- i))
(SETQ EN (SSNAME ITEMS i))
(SETQ ED (ENTGET EN))
(IF (= "TEXT" (CDR (ASSOC 0 ED)))
(PROGN
(SETQ OFFSET1 (/ (cdr (assoc 40 ED)) 2))
(SETQ OFFSET (/ (cdr (assoc 40 ED)) 3))
(SETQ E1 ED)
(SETQ ED (SUBST (CONS 72 2)
(ASSOC 72 ED) ED))
(ENTMOD ED)
(SETQ ED (ENTGET EN))
(SETQ PT1 (CDR (ASSOC 10 ED)))
(SETQ PT2 (CDR (ASSOC 11 ED)))
(SETQ LENGTH2 (DISTANCE PT1 PT2))
(SETQ ED E1)
(ENTMOD ED)
(SETQ PT1 (CDR (ASSOC 10 ED)))
(SETQ ANG1 (CDR (ASSOC 50 ED)))
(SETQ ANG2 (+ ANG1 (/ pi 2)))
(SETQ PT1 (POLAR PT1 (+ ANG1 pi)
OFFSET1))
(SETQ PT1 (POLAR PT1 (+ ANG2 pi)
OFFSET))
(SETQ PT2 (POLAR PT1 ANG1 (+
LENGTH2 (* 2 OFFSET))))
(SETQ LENGTH1 (+ (CDR (ASSOC 40
ED)) (* 2 OFFSET)))
(SETQ PT4 (POLAR PT1 ANG2
LENGTH1))
(COMMAND "line" PT1 PT4 "")
);progn
(progn; since it wasn't "TEXT" it's "MTEXT"
(vl-load-com)
(SETQ OFFSET1 (/ (cdr (assoc 40 ED)) 2))
(SETQ OFFSET (/ (cdr (assoc 40 ED)) 3))
(setq obj (vlax-ename->vla-object EN))
(vla-getboundingbox obj 'll 'ur)
(setq ll (vlax-safearray->list ll))
(setq ur (vlax-safearray->list ur))
(setq ang (+ (/ pi 2) (vla-get-rotation obj)))
(setq height (* (sin (- (angle ur ll) (+ (/ pi 2) ang))) (distance ll
ur)))
(setq pt2 (polar ll (+ (/ pi 2) ang) offset1))
(setq pt2 (polar pt2 (+ pi ang) offset))
(setq pt1 (polar pt2 ang (+ (* offset 2) height)))
(COMMAND "LINE" PT1 PT2 "")
);progn
);if
)
(SETVAR "CECOLOR" SAVE)
(PRIN1)
)