(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)
)
Here's the code I posted at the other forum if anyone is interested.Very slick. Nicely done Ron. :).........Yoink!
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)
)
great tools everybody, but ronjonp 's lisp worked best for me, simple ans fast
thanks a lot!!!!
Here's the code I posted at the other forum if anyone is interested.Very slick. Nicely done Ron. :).........Yoink!
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)
)
; 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)
)
)
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.
Specify leader arrowhead location or [leader Landing first/Content
first/Options] <Options>:
Specify next point:
Specify leader landing location:
and spits out this errorEnter text: ; error: Automation Error. Description was not provided.