Lệnh TXT2LEAD

Chuyển đổi Text và Leader thành MultiLeader (MLeader)

Lisp miễn phí của tác giả Ron Perez (ronperez@gmail.com)

1 Thêm file Txt2Lead.lsp

Lưu mã sau dưới dạng tệp tin AJS_.lsp

Code:

;;; AUTHOR
;;; Copyright© 2009 Ron Perez (ronperez@gmail.com)
;;; Inserts selected text\mtext into an mleader. If an associated leader is found
;;; with the selected text it is used for the new mleader location. Else an option to select a
;;; leader is given. If still nothing, two points are required and an mleader is
;;; created.   Enjoy :)

(defun c:txt2lead	(/	      allleaders   ent		elst	     ldrpts
		 ml	      objlst	   pt1		pt2	     ss
		 txt	      w		   x		rjp-getbbwdth
		 rjp-getpoints		   rjp-getassociatedleader
		)
  (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)))
  )
  (defun rjp-getpoints (ent)
    (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget ent)))
  )
  (defun rjp-getassociatedleader (ent / pts)
    (if	(and (setq ent (cdadr (member '(102 . "{ACAD_REACTORS") (entget ent))))
	     (setq pts (rjp-getpoints ent))
	)
      (list (car pts) (cadr pts) ent)
    )
  )
  (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 objlst (mapcar 'vlax-ename->vla-object
							   (setq elst (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 objlst) '>))
	    txt	   (substr txt 1 (1- (strlen txt)))
	    ldrpts (car	(setq allleaders
			       (reverse
				 (vl-remove 'nil
					    (mapcar 'rjp-getassociatedleader elst)
				 )
			       )
			)
		   )
      )
      (mapcar 'vla-delete objlst)
      (cond ;;leader found for one of the selected text
	    ((and ldrpts
		  (setq pt1 (car ldrpts))
		  (setq pt2 (cadr ldrpts))
		  (setq ent (caddr ldrpts))
	     )
	    )
	    ;;Select a leader
	    ((and (princ "\nSelect leader to replace [Enter to pick new points]: ")
		  (setq ss (ssget '((0 . "leader"))))
		  (setq ent (ssname ss 0))
		  (setq ldrpts (rjp-getpoints ent))
		  (setq pt1 (car ldrpts))
		  (setq pt2 (cadr ldrpts))
	     )
	    )
	    ;;Just add a new leader
	    ((and (setq pt1 (getpoint "\nSpecify leader arrowhead location: "))
		  (setq pt2 (getpoint pt1 "\nSpecify landing location: "))
	     )
	    )
      )
      (if (and pt1 pt2)
	(progn (command "._MLEADER" pt1 pt2 "")
	       (setq ml (vlax-ename->vla-object (entlast)))
	       (vla-put-textstring ml txt)
	       (vla-put-textwidth ml w)
	       (if ent
		 (progn	(if (setq txt (cdr (assoc 340 (entget ent))))
			  (entdel txt)
			)
			(entdel ent)
		 )
	       )
	       (mapcar 'entdel (mapcar 'caddr (cdr allleaders)))
	)
      )
    )
    (princ)
  )
)


;;; By RonJon
;;; Found at http://www.cadtutor.net/forum/showthread.php?41822-changing-text-mtext-to-multileaders...
;;;(defun c:txt2lead (/ 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)
;;;)

Nguồn: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/leader-and-mtext-to-multileader/td-p/13369978