CADXChange

Todos los comandos LISP

CXM2TTextoVersión 1.0.0Probado en AutoCAD

Descomponer texto multilínea en textos de una línea

Divide un texto multilínea en un texto de una línea por cada línea. Cada línea conserva su sitio, de modo que el resultado sirve para herramientas que solo entienden texto de una línea.

Cómo se usa

  1. Escribe CXM2T y selecciona los textos multilínea.
  2. Elige si se borran los originales.
  3. Cada línea se convierte en un texto propio, con el espaciado del original.

Conviene saber

  • Cada línea mantiene su posición dentro del texto multilínea, incluida la rotación.

Cargarlo en AutoCAD

  1. Guarda el archivo donde quieras.
  2. Escribe APPLOAD, elige el archivo y pulsa Cargar.
  3. Escribe el nombre del comando: CXM2T.

Para tenerlo en cada inicio, agrégalo al Contenido de inicio en el mismo cuadro de diálogo, o carga una carpeta entera de una vez con el cargador opcional. Sobre el cargador opcional

Probado en AutoCAD (versión completa). Otros programas que ejecutan AutoLISP pueden funcionar, pero no se han probado.

El código

Texto sin más, nada oculto. Cópialo en un archivo llamado cxm2t.lsp o descárgalo.

;;; ============================================================================
;;; CXM2T - Break MTEXT into single-line texts
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxm2t
;;; Tested in: AutoCAD (full version). Other programs that run AutoLISP may work but are not tested.
;;; Copyright (c) CADXChange. Free for personal and commercial use; do not resell or
;;; republish it as a collection. Terms: https://cadxchange.net/legal/lisp-terms
;;; ============================================================================

;; Break the MTEXT MT into one single-line TEXT per line, at the position each line has now.
;; DELETE = T erases the MTEXT. Returns the list of new TEXT entities.
(defun cx:m2t-run (mt delete / ed str lines n h pitch att rot top row col y local out e x just ang)
  (setq ed    (entget mt)
        str   (cx:text-plain (cx:text-get mt) T T)
        lines (cx:split-str str "\\P")
        n     (length lines)
        h     (cx:dxf 40 ed)
        pitch (* h 1.6667 (if (cx:dxf 44 ed) (cx:dxf 44 ed) 1.0))
        att   (if (cx:dxf 71 ed) (cx:dxf 71 ed) 1)
        row   (/ (1- att) 3)
        col   (rem (1- att) 3)
        ang   (cond ((cx:dxf 11 ed) (atan (cadr (cx:dxf 11 ed)) (car (cx:dxf 11 ed))))
                    ((cx:dxf 50 ed) (cx:dxf 50 ed))
                    (T 0.0))
        top   (+ (cadr (cx:dxf 10 ed)) (* (nth row (list 0.0 1.0 2.0)) 0.5 (+ (* (1- n) pitch) h)))
        out   nil)
  (setq just (nth col '(0 1 2)))
  (foreach l lines
    (setq y (- top h (* (length out) pitch))
          local (- y (cadr (cx:dxf 10 ed)))
          x (- (car (cx:dxf 10 ed)) (* local (sin ang)))
          y (+ (cadr (cx:dxf 10 ed)) (* local (cos ang))))
    (setq e
      (entmakex
        (append
          (list '(0 . "TEXT") (cons 8 (cx:dxf 8 ed)))
          (if (cx:dxf 62 ed) (list (cons 62 (cx:dxf 62 ed))))
          (list (list 10 x y (caddr (cx:dxf 10 ed))) (cons 40 h) (cons 1 l) (cons 50 ang) (cons 7 (if (cx:dxf 7 ed) (cx:dxf 7 ed) "STANDARD"))
                (cons 72 just))
          (if (> just 0) (list (list 11 x y (caddr (cx:dxf 10 ed)))))
          (list '(100 . "AcDbText") '(73 . 0)))))
    (if e (setq out (cons e out))))
  (if (and delete out) (entdel mt))
  (reverse out))

(defun c:CXM2T ( / *error* cx:sv ss del n)
  (setq *error* cx:err)
  (if (setq ss (cx:pick "\nSelect the MTEXT to break into lines: " '((0 . "MTEXT"))))
    (progn
      (setq del (= (cx:ask-kw "Erase the original MTEXT" "Yes No" "Yes") "Yes") n 0)
      (cx:start '(("CMDECHO" . 0)))
      (foreach e (cx:ss->list ss) (setq n (+ n (length (cx:m2t-run e del)))))
      (princ (strcat "\n" (itoa n) " line(s) created."))
      (cx:end)))
  (princ))


;;; ---- Shared helpers (used by the command above; identical in every CADXChange tool) ----

;; Split a TEXT (MT = nil) or MTEXT (MT = T) string into ((T . "plain") (C . "format code") ...).
;; Codes are %%c-style symbols, and in MTEXT also \P, \f...; \H...; \S...; {, } and the like.
(defun cx:fmt-tokens (str mt / out plain i n c d j k)
  (setq out nil plain "" i 1 n (strlen str))
  (while (<= i n)
    (setq c (substr str i 1) k 0)
    (cond
      ((and (= c "%") (= (substr str (1+ i) 1) "%") (< (1+ i) n))
       (setq k (if (wcmatch (substr str (+ i 2) 1) "#") 5 3)))
      ((and mt (= c "\\"))
       (setq d (substr str (1+ i) 1))
       (cond
         ((= d "") (setq k 1))
         ((member d '("P" "X" "x" "L" "l" "O" "o" "K" "k" "~" "\\" "{" "}")) (setq k 2))
         ((member d '("U" "u")) (setq k 7))
         (T
          (setq j i)
          (while (and (<= j n) (/= (substr str j 1) ";")) (setq j (1+ j)))
          (setq k (if (<= j n) (1+ (- j i)) 2)))))
      ((and mt (or (= c "{") (= c "}"))) (setq k 1)))
    (if (> k 0)
      (progn
        (if (/= plain "") (setq out (cons (cons 'T plain) out) plain ""))
        (setq out (cons (cons 'C (substr str i k)) out) i (+ i k)))
      (setq plain (strcat plain c) i (1+ i))))
  (if (/= plain "") (setq out (cons (cons 'T plain) out)))
  (reverse out))

;; The visible text of a TEXT or MTEXT string. In MTEXT, \P becomes a line break (KEEPNL = T: the two characters \P are kept).
(defun cx:text-plain (str mt keepnl / out)
  (setq out "")
  (foreach tk (cx:fmt-tokens str mt)
    (cond
      ((= (car tk) 'T) (setq out (strcat out (cdr tk))))
      ((= (cdr tk) "\\P") (setq out (strcat out (if keepnl "\\P" "\n"))))
      ((= (cdr tk) "\\~") (setq out (strcat out " ")))
      ((member (cdr tk) '("\\\\" "\\{" "\\}")) (setq out (strcat out (substr (cdr tk) 2))))))
  out)

(defun cx:dxf (code ed)
  (cdr (assoc code ed)))

;; The text of a TEXT, ATTRIB, ATTDEF or MTEXT (MTEXT keeps its codes).
(defun cx:text-get (ename / ed s)
  (setq ed (entget ename))
  (if (= (cx:dxf 0 ed) "MTEXT")
    (progn
      (setq s "")
      (foreach p ed (if (= (car p) 3) (setq s (strcat s (cdr p)))))
      (strcat s (cx:dxf 1 ed)))
    (cx:dxf 1 ed)))

;; 1-based position of SUB in STR at or after START, or nil.
(defun cx:find (str sub start / n i r)
  (setq n (strlen sub) i start r nil)
  (if (> n 0)
    (while (and (not r) (<= i (1+ (- (strlen str) n))))
      (if (= (substr str i n) sub) (setq r i))
      (setq i (1+ i))))
  r)

;; Split STR at every occurrence of the string DELIM.
(defun cx:split-str (str delim / out pos p)
  (setq out nil pos 1)
  (while (setq p (cx:find str delim pos))
    (setq out (cons (substr str pos (- p pos)) out) pos (+ p (strlen delim))))
  (reverse (cons (substr str pos) out)))

;; Close the undo step and put the system variables back.
(defun cx:end ()
  (foreach v cx:sv (setvar (car v) (cdr v)))
  (command "_.UNDO" "_End")
  (setq cx:sv nil)
  (princ))

;; Error handler: restores everything, stays quiet on Esc.
(defun cx:err (msg)
  (if (> (getvar "CMDACTIVE") 0) (command))
  (cx:end)
  (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg)))
  (princ))

;; Use the objects already selected, or ask the user to select; FILTER is an ssget filter list or nil.
(defun cx:pick (msg filter / ss)
  (setq ss (if filter (ssget "_I" filter) (ssget "_I")))
  (if (null ss)
    (progn
      (princ msg)
      (setq ss (if filter (ssget filter) (ssget)))))
  ss)

;; Replace every OLD in STR by NEW (case sensitive).
(defun cx:replace (str old new / n out pos)
  (setq n (strlen old) out "" pos 1)
  (if (= n 0)
    str
    (progn
      (while (<= pos (1+ (- (strlen str) n)))
        (if (= (substr str pos n) old)
          (setq out (strcat out new) pos (+ pos n))
          (setq out (strcat out (substr str pos 1)) pos (1+ pos))))
      (strcat out (substr str pos)))))

;; Ask for one of the keywords in BITS ("Yes No"), default DEF; returns the keyword.
(defun cx:ask-kw (msg bits def / v)
  (initget 0 bits)
  (setq v (getkword (strcat "\n" msg " [" (cx:replace bits " " "/") "] <" def ">: ")))
  (if v v def))

;; Save the system variables in VARS ((name . value) ...), set them, and open one undo step.
;; The caller declares cx:sv as a local so the saved values live exactly as long as the command.
(defun cx:start (vars)
  (setq cx:sv (mapcar (function (lambda (v) (cons (car v) (getvar (car v))))) vars))
  (command "_.UNDO" "_Begin")
  (foreach v vars (setvar (car v) (cdr v)))
  (princ))

;; Selection set to a list of entity names.
(defun cx:ss->list (ss / i out)
  (setq i 0)
  (if ss
    (repeat (sslength ss)
      (setq out (cons (ssname ss i) out)
            i   (1+ i))))
  (reverse out))

(princ "\nCXM2T loaded. Type CXM2T to start.")
(princ)

Historial de versiones

Versión 1.0.0 · 27 de octubre de 2026

Primera versión.

¿Lo necesitas en muchos dibujos?

TextSync hace este tipo de trabajo con toda una carpeta de dibujos en una sola pasada.

TextSync

Más comandos: Texto