My #1 favorite Lisp code

Well its close to Christmas time, so I thought I would share my #1 favorite lisp code with everyone who's read my BLOG this year. So what is this code? The code is called TLEAD. TLEAD stands for Text leader. The difference between this code and may AutoCAD commands like LEADER and QLEADER is this one actually allows you to control the way the leader is placed.

When you issue the TLEAD command you are prompted to select a string of text. Here you can select the left or right side of the string of text. You then select the start point for the leader, and you'll now get a rubber band effect with a horizontal tracking. You then can select the point you want to place the landing for the leader, and thats it. This command I probably use hundreds of times a day. By far the most popular command in our office.

I hope everyone enjoys this little routine, and has a wonderful holiday.

You can download the file here: Download TLEAD.LSP

(defun c:tlead
       (/ tobj tlist dtlist dtinsp dtenttb p1 p2 dthalfwidth+gap)
 
  (setvar "cmdecho" 0)
   (setq tobj (entsel "\nSelect Top or Bottom Line of Text: "))
  (setq tlist (entget (car tobj)))
  (if (= (cdr (assoc 0 tlist)) "TEXT")
    (progn
      (setq dtenttb (textbox (entget (car tobj))))
      (setq dtlist (entget (car tobj)))
    )
  )
  (if (= (cdr (assoc 0 tlist)) "MTEXT")
    (progn
      (command "explode" tobj)
      (setq mtline (ssget (cadr tobj))) ;warning! This uses the cursor's position, not an actual object point!
      (setq dtlist (entget (ssname mtline 0)))
      (setq dtenttb (textbox (entget (ssname mtline 0))))
      (command "u")
    )
  )
  (setq dtinspt (cdr (assoc 10 dtlist)))
  (setq p1 (list (/ (+ (caadr dtenttb) (caar dtenttb)) 2.0)
   (/ (+ (cadar dtenttb) (cadadr dtenttb)) 2.0)
   (cadddr (assoc 10 dtlist))
    )
  )
  (setq inspt (list (+ (car dtinspt) (car p1))
   (+ (cadr dtinspt) (cadr p1))
   (+ (caddr dtinspt) (caddr p1))
    )
  )
  (setq dthalfwidth+gap
  (+ (/ (- (caadr dtenttb) (caar dtenttb)) 2.0)
     (* 0.03625 (getvar "dimscale"))
  )
  )
  (prompt "\nSelect Leader Start and Bend Points: ")
  (command "leader"
    pause
    ".Y"
    inspt
    pause
    (polar inspt (angle inspt (getvar "lastpoint")) dthalfwidth+gap)
    ""
    ""
    "n"
  )
  (princ)
)

Comments

[Jim Haglund]

Is there a setting that could be added to have a little bigger gap between the end of the tail and the text?

Thanks. I like the routine!

Jim H

[Mike Weaver]

I use this routine a lot as well and was particularly impressed with the ingenious way to find the end of a particular line in an mtext object. Pretty slick. Now if I could just figure out why it fails occasionally:-(

[Mark Douglas]

Hi Jim, yes you can modify this setting to give you a little bigger gap.

If you search at the bottom of the code for a string called

(setq dthalfwidth+gap
(+ (/ (- (caadr dtenttb) (caar dtenttb)) 2.0)
(* 0.03625 (getvar "dimscale"))
)
)

If you take the value that says 0.03625 and adjust it to say, 0.06 or 0.07 you will see the landing begin to appear farther away form the text. Hope this helps!!

Mark

[Mark Douglas]

I occasionally also find that it crashes out, but for me its with really old mtext objects who seem to just crash out? But other than that it seems to work very well. I also agree that the way to get the Mtext points it is pretty slick!! Glad everyone likes it!!

[Dave]

Mark
I'm confused. Why would you want to not have an associated qleader? I want my leader and text grouped together. What I do is do a 2 point leader. Then use the qlattach command. The only problem is that I normally have to streatch the tail down but after that its a linked leader and note.

[Mark Douglas]

The reason I don't prefer a Qleader is the Qleader doesn't allow you the ability to modify the "Landing" length. We always have times where we need to place that landing in different lengths. So with Qleaders locked down length it makes it un-sable for us. Now if had the ability to adjust landing lengths for each different string of text then we would be all set to go!! Hope this makes sense.

[Ram P]

Nice, i am using this program frequently. If any updations made by u mail me
Thanks, i like this routine

[Jon Donenko]

Mark
I have just recently started using this command and like it for the most part. However I have noticed that about 1/2 of the time I use it the second line segment doesn't come out horizontal. I was wondering if there was a way to force the second segment to always come out horizontal or if there was a way to get it to throw up the settings dialog box so I can tell it to place a horizontal second segment?

[jeff johnson]

please help get this multrim lsp
working with autocad 2006

it works with all other autocads

;JEFF JOHNSON

; program: MULTIPLE TRIM COMMAND - MULTRIM.LSP
;
; description: Trims with selection of many items to trim
; actual selection is by crossing, and items
; must cross a line between the selected crossing
; points. No allowance is made for removal of
; items from the selection set.
;
;
; variables used and their description:
;cs selection set containing cutting edges
;p1 first point for crossing selection (for ts)
;p2 second point for crossing selection (for ts)
;tss election set containing items to be trimmed
;ic item count through trim set (ts)
;te entity name from ts to trim
;ge entity list of te
;et entity type of te
;cp center point of arc or circle
;ra radius of arc or circle
;sa start angle of arc or circle (arbitrarily 0 for circle)
;ea end angle of arc or circle (arbitrarily 2pi for circle)
;dv divisor for number of segments to increment arcs
;ma intermediate angle of arc increment
;ia increment angle for arcs (approximately 10-degrees)
;p3 first point on entity to check for an intersection
;p4 second intersection check point (used with arcs and polylines)
;tp trim point on entity to trim
;e3 vertex of polyline used to get p3
;e4 vertex of polyline used to get p4
;d1,d1,p3 intermediate variables to determine tp on circles
;
;
(DEFUN C:MULTRIM ()
(setvar "CMDECHO" 0)
(princ "\nSelect cutting edges: ")
(setq cs (ssget))
(princ "Select objects to cut: ")
(setq p1 (getpoint "Select first point: ")
p2 (getpoint p1 "Select other point: ")
ts (ssget "c" p1 p2)
ic 0
)
(grdraw p1 p2 -1 1)
(while (setq te (ssname ts ic))
(if (ssmemb te cs)
(setq et nil)
(setq ge (entget te)
et (cdr (assoc 0 ge))
)
)
(cond
((= et "ARC")
(setq cp (cdr (assoc 10 ge))
ra (cdr (assoc 40 ge))
sa (cdr (assoc 50 ge))
ea (cdr (assoc 51 ge))
)
(if (> sa ea)
(setq ea (+ ea pi pi))
)
(if (> 2 (setq dv (fix (/ (- ea sa) (/ pi 18))) ))
(setq dv 2)
)
(setq ma sa
ia (/ (- ea sa) dv)
p4 (polar cp sa ra)
)
(while (< ma ea)
(setq p3 p4
p4 (polar cp (setq ma (+ ma ia)) ra)
)
(if (setq tp (inters p1 p2 p3 p4))
(command "TRIM" cs "" (list te tp) "")
)
)
)
((= et "CIRCLE")
(setq cp (cdr (assoc 10 ge))
ra (cdr (assoc 40 ge))
d1 (* (cos (- (angle p1 cp) (angle p1 p2))) (distance cp p1))
p3 (polar p1 (angle p1 p2) d1)
d2 (distance cp p3)
tp (polar p3 (angle p1 p2) (sqrt (- (* ra ra) (* d2 d2) )))
)
(command "TRIM" cs "" (list te tp) "")
)
((= et "POLYLINE")
(setq e3 (entget (entnext te))
p3 (cdr (assoc 10 e3))
)
(while (/= "SEQEND" (cdr (assoc 0 (setq e4 (entget (entnext
(cdr (assoc -1 e3))) ))) ))
(setq p4 (cdr (assoc 10 e4)))
(if (setq tp (inters p1 p2 p3 p4))
(progn
(command "TRIM" cs "" (list te tp) "")
(setq e4 (entget (entnext (setq te (entlast) )))
p4 (cdr (assoc 10 e4))
)
)
)
(setq e3 e4
p3 p4
)
)
)
((= et "LINE")
(if (setq tp (inters (cdr (assoc 10 ge)) (cdr (assoc 11 ge)) p1 p2))
(command "TRIM" cs "" (list te tp) "")
)
)
)
(setq ic (1+ ic))
)
(grdraw p1 p2 -1 1)
(setq cs nilp1 nilp2 nilts nilge nilic nilte nilet nil
tp nilcp nilra nilsa nilea nilma nilma nilia nil
p3 nilp4 nild1 nild2 nile3 nile4 nil
)
(princ)
)

[senvin kumar]

Mark
how to transfer? in excel to acad. i am always use read-line code. but output is "1111\t22222\t3333". do not use substr code. pls. help.

thankyou

regards
senvin