;;----------------------=={ Merge Text }==--------------------;;
;; ;;
;; Converts a selection of single-character text objects ;;
;; into one or more text objects containing characters ;;
;; aligned by their insertion points & angle of rotation. ;;
;; Currently restricted to text containing no spaces. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2012 - <a href=\"http://www.lee-mac.com\" target=\"_blank\">www.lee-mac.com</a> ;;
;;------------------------------------------------------------;;
(defun c:mergetext ( / i l s )
(if (setq s (ssget "_" '((0 . "TEXT"))))
(progn
(repeat (setq i (sslength s))
(setq l (cons (entget (ssname s (setq i (1- i)))) l))
)
(foreach g
(LM:GroupByFunction l
(lambda ( a b / n r z )
(and
(equal (setq r (cdr (assoc 050 a))) (cdr (assoc 050 b)) 0.001)
(equal (setq z (cdr (assoc 210 a))) (cdr (assoc 210 b)) 0.001)
(setq n (list (cos r) (sin r)))
(equal
(car (trans (cdr (assoc 10 a)) z n))
(car (trans (cdr (assoc 10 b)) z n))
0.001
)
)
)
)
(if (cdr g)
(progn
(setq g
(vl-sort g
(function
(lambda ( a b / n r z )
(setq r (cdr (assoc 050 a))
z (cdr (assoc 210 a))
n (list (cos r) (sin r))
)
(< (last (trans (cdr (assoc 10 a)) z n))
(last (trans (cdr (assoc 10 b)) z n))
)
)
)
)
)
(entmod
(subst
(cons 1 (apply 'strcat (mapcar '(lambda ( x ) (cdr (assoc 1 x))) g)))
(assoc 1 (car g))
(car g)
)
)
(foreach e (cdr g) (entdel (cdr (assoc -1 e))))
)
)
)
)
)
(princ)
)
;; Group By Function - Lee Mac
;; Groups items considered equal by a given predicate function