mtext lisp

Have a question or want to show off your project? Post it! No Registration Necessary.  Now with pictures!

Threaded View
Is there any way to create mtext with a lisp routine? I am using 2006
if that makes a difference.


Re: mtext lisp
Maintenancedude2000@yahoo.com wrote:
Quoted text here. Click to load it
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

Re: mtext lisp
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: 100015.1632@CompuServe.com
;;;
;;; 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)
)



Janice G wrote:
Quoted text here. Click to load it

Re: mtext lisp
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

Janice G wrote:
Quoted text here. Click to load it

Site Timeline