Jump to content

changing text/mtext to multileaders...


chrisdarmanin

Recommended Posts

I threw this together a while back to put text into an mleader. It works with single or multiline text and sorts from top to bottom. The mleader created used the current mleader style.....enjoy :)

 

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

Link to comment
Share on other sites

  • 12 years later...
On 11/10/2009 at 11:39 PM, ronjonp said:

I threw this together a while back to put text into an mleader. It works with single or multiline text and sorts from top to bottom. The mleader created used the current mleader style.....enjoy :)

 

 

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

 

Good afternoon. Can you tweak the code a bit? I've been sitting here for a day and a half and still can't figure it out.
I would like it to take the original location points instead of selecting the arrow location. And leave the second action (specify the landing location) as it is
For example, like this pictureimage.thumb.png.92c773eddcfb1087b30cc3364721f04d.png

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...