Go Back   Cadalyst Discussion Forums > Forums > CAD Managers
FAQ Members List Social Groups Calendar Search Today's Posts Mark Forums Read

Notices

CAD Managers Robert Green moderates CAD management issues.

 
 
Thread Tools Display Modes
  #1  
Old 09-13-2011, 12:40 PM
GBarfield GBarfield is offline
Junior Member
 
Join Date: Jun 2004
Posts: 2
Default Lisp Modification for Text

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)
)
 

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump


All times are GMT -6. The time now is 04:35 PM.





Powered by vBulletin® Version 3.8.4
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.