Topic: lisp request please - text to multileader

[chrisdarmanin]

i'm linking from another post of mine because now its appropriate to be here

http://www.theswamp.org/index.php?topic=30907.msg364584#msg364584

well what do you think?

[Slim©]

Have you seen this?

[Crank]

http://discussion.autodesk.com/forums/message.jspa?messageID=6190268

[CAB]

And this:
http://www.theswamp.org/index.php?topic=22949.msg276576#msg276576

[ronjonp]

Here's the code I posted at the other forum if anyone is interested.
I updated the code to add a width to the text to "kinda" mimic the same size the text occupies on the screen.

Code: [Select]

(defun c:am (/ newleader pt1 pt2 ss txt x w rjp-getbbwdth)
  (vl-load-com)
  (defun rjp-getbbwdth (obj / out ll ur)
    (vla-getboundingbox obj 'll 'ur)
    (setq out (mapcar 'vlax-safearray->list (list ll ur)))
    (distance (car out) (list (caadr out) (cadar out)))
  )
  (if (setq ss (ssget '((0 . "*TEXT"))))
    (progn (setq txt (apply
      'strcat
      (mapcar
'cdr
(vl-sort
  (mapcar '(lambda (x)
     (cons (vlax-get x 'insertionpoint)
   (strcat (vlax-get x 'textstring) " ")
     )
   )
  (setq
    ss (mapcar
 'vlax-ename->vla-object
 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
  )
  )
  (function (lambda (y1 y2) (< (cadr (car y2)) (cadr (car y1))))
  )
)
      )
    )
w   (car (vl-sort (mapcar 'rjp-getbbwdth ss) '>))
txt (apply 'strcat
   (mapcar 'chr (reverse (cdr (reverse (vl-string->list txt)))))
    )
  )
  (mapcar 'vla-delete ss)
    )
  )
  (if (and (setq pt1 (getpoint "\nSpecify leader arrowhead location: "))
  (setq pt2 (getpoint pt1 "\nSpecify landing location: "))
      )
    (progn (command "._MLEADER" pt1 pt2 "")
  (setq newleader (vlax-ename->vla-object (entlast)))
  (vla-put-textstring newleader txt)
  (vla-put-textwidth newleader w)
    )
  )
  (princ)
)

[chrisdarmanin]

great tools everybody, but ronjonp 's lisp worked best for me, simple ans fast

thanks a lot!!!!

[alanjt]

Here's the code I posted at the other forum if anyone is interested.
I updated the code to add a width to the text to "kinda" mimic the same size the text occupies on the screen.

Code: [Select]

(defun c:am (/ newleader pt1 pt2 ss txt x w rjp-getbbwdth)
  (vl-load-com)
  (defun rjp-getbbwdth (obj / out ll ur)
    (vla-getboundingbox obj 'll 'ur)
    (setq out (mapcar 'vlax-safearray->list (list ll ur)))
    (distance (car out) (list (caadr out) (cadar out)))
  )
  (if (setq ss (ssget '((0 . "*TEXT"))))
    (progn (setq txt (apply
       'strcat
       (mapcar
'cdr
(vl-sort
   (mapcar '(lambda (x)
      (cons (vlax-get x 'insertionpoint)
    (strcat (vlax-get x 'textstring) " ")
      )
    )
   (setq
     ss (mapcar
  'vlax-ename->vla-object
  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
   )
   )
   (function (lambda (y1 y2) (< (cadr (car y2)) (cadr (car y1))))
   )
)
       )
     )
w   (car (vl-sort (mapcar 'rjp-getbbwdth ss) '>))
txt (apply 'strcat
    (mapcar 'chr (reverse (cdr (reverse (vl-string->list txt)))))
     )
   )
   (mapcar 'vla-delete ss)
    )
  )
  (if (and (setq pt1 (getpoint "\nSpecify leader arrowhead location: "))
   (setq pt2 (getpoint pt1 "\nSpecify landing location: "))
      )
    (progn (command "._MLEADER" pt1 pt2 "")
   (setq newleader (vlax-ename->vla-object (entlast)))
   (vla-put-textstring newleader txt)
   (vla-put-textwidth newleader w)
    )
  )
  (princ)
)

Very slick. Nicely done Ron. .........Yoink!

[ronjonp]

great tools everybody, but ronjonp 's lisp worked best for me, simple ans fast

thanks a lot!!!!

Not a problem...glad you like it 

[ronjonp]

Here's the code I posted at the other forum if anyone is interested.
I updated the code to add a width to the text to "kinda" mimic the same size the text occupies on the screen.

Code: [Select]

(defun c:am (/ newleader pt1 pt2 ss txt x w rjp-getbbwdth)
  (vl-load-com)
  (defun rjp-getbbwdth (obj / out ll ur)
    (vla-getboundingbox obj 'll 'ur)
    (setq out (mapcar 'vlax-safearray->list (list ll ur)))
    (distance (car out) (list (caadr out) (cadar out)))
  )
  (if (setq ss (ssget '((0 . "*TEXT"))))
    (progn (setq txt (apply
       'strcat
       (mapcar
'cdr
(vl-sort
   (mapcar '(lambda (x)
      (cons (vlax-get x 'insertionpoint)
    (strcat (vlax-get x 'textstring) " ")
      )
    )
   (setq
     ss (mapcar
  'vlax-ename->vla-object
  (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
   )
   )
   (function (lambda (y1 y2) (< (cadr (car y2)) (cadr (car y1))))
   )
)
       )
     )
w   (car (vl-sort (mapcar 'rjp-getbbwdth ss) '>))
txt (apply 'strcat
    (mapcar 'chr (reverse (cdr (reverse (vl-string->list txt)))))
     )
   )
   (mapcar 'vla-delete ss)
    )
  )
  (if (and (setq pt1 (getpoint "\nSpecify leader arrowhead location: "))
   (setq pt2 (getpoint pt1 "\nSpecify landing location: "))
      )
    (progn (command "._MLEADER" pt1 pt2 "")
   (setq newleader (vlax-ename->vla-object (entlast)))
   (vla-put-textstring newleader txt)
   (vla-put-textwidth newleader w)
    )
  )
  (princ)
)

Very slick. Nicely done Ron. .........Yoink!

Thanks Alan  :kewl:

[cmwade77]

First off, Ronjonp, I have to say, awesome code, I have had a routine that convert leaders with mtext, but quite often the details that I have been converting didn't even use mtext on the leaders, so this has been a huge help.

I have modified the code to be able to convert the line from the leader as well, it is not perfect at getting the insertion points right, but it is close and I am sure that there are plenty of improvements that can be made:

Code: [Select]

; Modified from original code posted by ronjonp at http://www.theswamp.org/index.php?topic=30914.0
; Modifications made by cmwade77 at http://www.theswamp.org
(defun c:l2m ()
  (vl-load-com)
  (defun rjp-getbbwdth (obj / out ll ur)
    (vla-getboundingbox obj 'll 'ur)
    (setq out (mapcar 'vlax-safearray->list (list ll ur)))
    (distance (car out) (list (caadr out) (cadar out)))
  )
 (princ "\nSelect items to convert to mleader: ")
 (setq items (ssget))

(setq a 0)
(setq ss (ssadd))
(setq ss2 (ssadd))

(while (< a (sslength items))
(progn
(setq EA (entget (ssname items a)))
(setq EC (cdr (assoc 0 EA)))
(if (and (/= EC nil) (/= EC null) (/= EC ""))
(progn
(if (WCMATCH EC "*TEXT")
(ssadd (ssname items a) ss)
(ssadd (ssname items a) ss2)
)
)
)
(setq a (+ a 1))
)
)

 (if (= (sslength ss2) 1)
(progn
(setq leader2 (entget (ssname ss2 0)))
)
(progn
(setq leader (entsel "\nInvalid Leader Selected\nPick Leader: ")
     leader2(entget (car leader)))
)
)
 
 (setq
pt1 (dxf 10 leader2) ; get first point of leader
  )
 
 (vl-cmdf "._ERASE" ss2 "")
  (if (> (sslength ss) 0)
 
    (progn
(setq EE (entget (ssname ss (- (sslength ss) 1))))
  (setq pt2 (cdr (assoc 10 EE)))
(setq txt (apply
      'strcat
      (mapcar
'cdr
(vl-sort
  (mapcar '(lambda (x)
     (cons (vlax-get x 'insertionpoint)
   (strcat (vlax-get x 'textstring) " ")
     )
   )
  (setq
    ss (mapcar
 'vlax-ename->vla-object
 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
  )
  )
  (function (lambda (y1 y2) (< (cadr (car y2)) (cadr (car y1))))
  )
)
      )
    )
w   (car (vl-sort (mapcar 'rjp-getbbwdth ss) '>))
txt (apply 'strcat
   (mapcar 'chr (reverse (cdr (reverse (vl-string->list txt)))))
    )
  )

  (mapcar 'vla-delete ss)
 
 
    )
  )

  (progn
       (command "._MLEADER" pt1 pt2 "")
  (setq newleader (vlax-ename->vla-object (entlast)))
  (vla-put-textstring newleader txt)
  (vla-put-textwidth newleader w)
  )

  )


I normally will use this command on each leader that I need to convert, then use the mleader align command to get everything lined up the way I want.

I changed the command to L2M as well, as it modifies the way the old one functions, so I want to make sure that I don't step on anyone's toes. All you need to do is select the leader line at the same time that you select the text to convert. I hope it works for you as well as it does for me.

Feel free to modify this code, just make sure that credit is given as appropriate.

[butzers09silverado]

I tried ronjon lisp and got the following error:

Code: [Select]

Select objects:
Command: ._MLEADER
Specify leader arrowhead location or [leader Landing first/Content
first/Options] <Options>:
Specify next point:
Specify leader landing location:
Enter text: ; error: Automation Error. Description was not provided.

it blows right past

Code: [Select]

Specify leader arrowhead location or [leader Landing first/Content
first/Options] <Options>:
and blows past

Code: [Select]

Specify next point:
and continues past

Code: [Select]

Specify leader landing location:
and spits out this error

Code: [Select]

Enter text: ; error: Automation Error. Description was not provided.

usc is NOT set to world

[ronjonp]

Butzers,

Are you using the code from this post?

http://www.theswamp.org/index.php?topic=30934.msg364891#msg364891

[cmwade77]

Here is my latest version of the L2M command, I think you will find it works really well and you can edit it to enable some additional options that are currently remarked out. (These are setup to set things to our company's specific standards, based on various factors, i.e. If you a pointing to an object or not, etc.)

[ira]

Hello all, this lisp works great but i would like to know if someone can do a slight modification. The reason i am using this lisp is because i have many drawings where the leaders have been exploded. So i would like to replace the text and exploded leaders with multileaders. I wont the new multileader to be in the same place as the old one so what i would like to do is pick the leaders to delete but not actually delete them until i can pick the points to where they are for the new leader. This way i don't lose the existing position of the existing leaders. I hope this make sense. Can anyone help me with this. The lisp is below.

Code - Auto/Visual Lisp: [Select]

1. (defun c:am (/ newleader pt1 pt2 ss txt x w rjp-getbbwdth)
2.   (vl-load-com)
3.   (defun rjp-getbbwdth (obj / out ll ur)
4.     (vla-getboundingbox obj 'll 'ur)
5.     (setq out (mapcar 'vlax-safearray->list (list ll ur)))
6.     (distance (car out) (list (caadr out) (cadar out)))
7.     )
8.   (if (setq ss (ssget '((0 . "*TEXT"))))
9.     (progn (setq txt (apply
10.                        'strcat
11.                        (mapcar
12.                          'cdr
13.                          (vl-sort
14.                            (mapcar '(lambda (x)
15.                                       (cons (vlax-get x 'insertionpoint)
16.                                             (strcat (vlax-get x 'textstring) " ")
17.                                             )
18.                                       )
19.                                    (setq
20.                                      ss (mapcar
21.                                           'vlax-ename->vla-object
22.                                           (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
23.                                           )
24.                                      )
25.                                    )
26.                            (function (lambda (y1 y2) (< (cadr (car y2)) (cadr (car y1))))
27.                                      )
28.                            )
29.                          )
30.                        )
31.                  w (car (vl-sort (mapcar 'rjp-getbbwdth ss) '>))
32.                  txt (apply 'strcat
33.                             (mapcar 'chr (reverse (cdr (reverse (vl-string->list txt)))))
34.                             )
35.                  )
36.            (mapcar 'vla-delete ss)
37.            )
38.     )
39.   (if (and (setq pt1 (getpoint "\nSpecify leader arrowhead location: "))
40.            (setq pt2 (getpoint pt1 "\nSpecify landing location: "))
41.            )
42.     (progn (command "._MLEADER" pt1 pt2 "")
43.            (setq newleader (vlax-ename->vla-object (entlast)))
44.            (vla-put-textstring newleader txt)
45.            (vla-put-textwidth newleader w)
46.            )
47.     )
48.   (princ)
49.   )

EDIT (John): Added code tag and reformatted code for readability.

[cmwade77]

The l2m.lsp file in the previous post should actually keep all of the leaders in the exact same place without needing to pick points, although the lines do need to be plines as I recall, but the command tries to make them pLines and join them if they aren't.

[ira]

L2M lisp asks to pick as much text as you want to make part of the multileader, then asks you to pick a single line to turn into the leader part of the multileader.  So because the exploede leader I am trying to turn into a multileader is just a bunch of lines (not poly lines)it does not do what i want.  I think the lisp im asking to be modified is the way to go I just want to be able to delete the original exploded lines.

[cmwade77]

Looking at the code, I just realized it is out of date, the attached code should work for you.

As for modifying the existing code, this SHOULD work; however, there may be circumstances where it won't work or will produce undesirable results since you would not have selected the lines at any point in time a crossing window would need to be used. An alternative approach is to select the lines and extract the start and end points from that and erase the lines, which is essentially what my code in the attached LISP does.

Code - Auto/Visual Lisp: [Select]

1. (defun c:am (/ newleader pt1 pt2 ss txt x w rjp-getbbwdth)
2.   (vl-load-com)
3.   (defun rjp-getbbwdth (obj / out ll ur)
4.     (vla-getboundingbox obj 'll 'ur)
5.     (setq out (mapcar 'vlax-safearray->list (list ll ur)))
6.     (distance (car out) (list (caadr out) (cadar out)))
7.     )
8.   (if (setq ss (ssget '((0 . "*TEXT"))))
9.     (progn (setq txt (apply
10.                        'strcat
11.                        (mapcar
12.                          'cdr
13.                          (vl-sort
14.                            (mapcar '(lambda (x)
15.                                       (cons (vlax-get x 'insertionpoint)
16.                                             (strcat (vlax-get x 'textstring) " ")
17.                                             )
18.                                       )
19.                                    (setq
20.                                      ss (mapcar
21.                                           'vlax-ename->vla-object
22.                                           (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
23.                                           )
24.                                      )
25.                                    )
26.                            (function (lambda (y1 y2) (< (cadr (car y2)) (cadr (car y1))))
27.                                      )
28.                            )
29.                          )
30.                        )
31.                  w (car (vl-sort (mapcar 'rjp-getbbwdth ss) '>))
32.                  txt (apply 'strcat
33.                             (mapcar 'chr (reverse (cdr (reverse (vl-string->list txt)))))
34.                             )
35.                  )
36.            (mapcar 'vla-delete ss)
37.            )
38.     )
39.   (if (and (setq pt1 (getpoint "\nSpecify leader arrowhead location: "))
40.            (setq pt2 (getpoint pt1 "\nSpecify landing location: "))
41.            )
42.     (progn
43. (set oPt1 (osnap pt1 "_nea")
44.        oPt2 (osnap pt2 "_nea"))
45. (if (/= oPt1 nil)
46. (progn
47. (if (/= oPt2 nil)
48. (command "._erase" "_c" oPt1 oPt2 "")
49.  (command "._erase" oPt1 "")
50. )
51. )
52.  
53. (command "._MLEADER" pt1 pt2 "")
54.            (setq newleader (vlax-ename->vla-object (entlast)))
55.            (vla-put-textstring newleader txt)
56.            (vla-put-textwidth newleader w)
57.            )
58.     )
59.   (princ)
60.   )
61.