Is there any way to create mtext with a lisp routine? I am using 2006 if that makes a difference.
Yes, I have one. I can send it to you. Don't know where it came from. Is your e-mail address shown here valid? Janice
Duh! Why not just copy the file contents and post? Sorry folks, brain-freeze, I guess. Well, here 'tis. Oh, be sure and read the "restrictions" part. You must select, in order, line by line, otherwise your finished project will be all jumbled. ;;; Text2MText ;;; (c) 1995 CR/LF GmbH, Essen/Germany ;;; Custom AutoCAD Programming since 1986 ;;; ;;; CR/LF GmbH ----------- ;;; Obere Fuhr 27 | CR / | | ;;; D-45136 Essen || / LF | | ;;; Tel.: ++49 201 254566 || <-------+ | ;;; Fax: ++49 201 256669 | ----------- ;;; CIS: 100015,1632 ----------- ;;; Internet: ;;; ;;; This program is copyrighted. It may be distributed freely however. ;;; ;;; Benefit: ;;; This file implements an AutoCAD command to combine selected text lines ;;; to a single mtext object. ;;; ;;; Usage: ;;; Load this file with AutoCAD's APPLOAD command. ;;; Enter TEXT2MTEXT. ;;; Pick the reference text. The mtext object will use this entity's ;;; properties including style, text height, layer a.s.o. ;;; Select the other text entities to append to the reference text. ;;; Done. ;;; ;;; Restrictions: ;;; Select the text to combine by clicking. Using crossing or windowing ;;; may result in an unwanted text sequence. ;;; (defun c:text2mtext (/ dxf ss index ent mtext) (defun dxf (tag obj) (cdr (assoc tag obj))) (cond ((not (setq reftext (car (entsel "Pick reference text")))) (princ "Nothing selected")) ((not (= (dxf 0 (setq reftext (entget reftext))) "TEXT")) (princ "Not a text")) ((not (setq ss (ssget))) (princ "Nothing selected")) (T (setq index 0.0 mtext '((0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText")) mtext (append mtext (list (assoc 8 reftext) (assoc 10 reftext) (assoc 7 reftext) (assoc 40 reftext) (cons 41 (abs (- (caar (textbox reftext)) (caadr (textbox reftext))))) (cons 3 (strcat (dxf 1 reftext) "\\P")))) ) (entdel (dxf -1 reftext)) (repeat (sslength ss) (cond ((not (= (dxf 0 (setq ent (entget (ssname ss index)))) "TEXT") ) (princ "Non-text ignored") ) (T (setq mtext (append mtext (list (cons 3 (strcat (dxf 1 ent) "\\P"))))) (entdel (dxf -1 ent)) ) ) (setq index (1+ index)) ) (entmake (append mtext '((1 . " ")))) ) ) (princ) )
It's fairly easy to fix the selection issue. Here's part of a routine I use that takes selection set sset1 and re-orders it to sset2. (while (> (sslength sset1) 0) (setq total_items (sslength sset1)) ; save the number of text lines (if (= base_insertion "") (set_base) ) (setq index 0) ; initialize the pointer (setq saved_distance 99999.9) ; initialize the entity distance ; from base variable (while (< index total_items) (setq this_item (ssname sset1 index)) ; get the next item in the ; selection set (setq this_entity (entget this_item)) ; get the next entity (setq this_insertion (cdr (assoc 10 this_entity))) ; use the base alignment point (setq this_distance (abs (- (cadr base_insertion) (cadr this_insertion) ) ) ) ; get the new Y distance (if (< this_distance saved_distance) (progn (setq saved_distance this_distance) (setq saved_item this_item) ) ) (setq index (1+ index)) ) (setq sset2 (ssadd saved_item sset2)) ; add item to the new ; selection set (ssdel saved_item sset1) ; and delete it from the old ) It also needs this subroutine: (defun set_base (/ dist entity1 entity2 i1 i2 item1 item2 j1 j2 left_just left_just1 left_just2 max_dist pt1 pt2 total_items ) (setq total_items (sslength sset1)) (setq i1 0) (setq i2 1) (setq max_dist 0.0) (if (> total_items 1) (progn (while (< i1 (- total_items 1)) (while (< i2 total_items) (setq item1 (ssname sset1 i1)) (setq entity1 (entget item1)) (setq item2 (ssname sset1 i2)) (setq entity2 (entget item2)) (setq pt1 (cdr (assoc 10 entity1))) (setq pt2 (cdr (assoc 10 entity2))) (setq dist (abs (- (cadr pt1) (cadr pt2)))) ; get Y distance (if (> dist max_dist) (progn (setq j1 i1) (setq j2 i2) (setq max_dist dist) ) ) (setq i2 (+ i2 1)) ) (setq i1 (+ i1 1)) (setq i2 1) ) (setq item1 (ssname sset1 j1)) (setq entity1 (entget item1)) (setq pt1 (cdr (assoc 10 entity1))) (setq item2 (ssname sset1 j2)) (setq entity2 (entget item2)) (setq pt2 (cdr (assoc 10 entity2))) (if (> (cadr pt1) (cadr pt2)) (setq base_insertion pt1) (setq base_insertion pt2) ) ) (progn (setq item1 (ssname sset1 0)) (setq entity1 (entget item1)) (setq pt1 (cdr (assoc 10 entity1))) (setq base_insertion pt1) ) ) ) Martin