CXTXTCUTTestoVersione 1.0.0Provato in AutoCAD
Tagliare caratteri all'inizio o alla fine dei testi
Elimina i primi o gli ultimi caratteri di ogni testo selezionato, oppure tutto ciò che sta prima o dopo un segnaposto che indichi.
Come si usa
- Digita CXTXTCUT e seleziona i testi.
- Scegli First, Last, Before o After.
- Per First e Last indica il numero di caratteri, per Before e After il testo di riferimento.
Da sapere
- I testi multilinea con formattazione propria vengono saltati e contati nel rapporto, così nulla viene danneggiato.
Caricarlo in AutoCAD
- Salva il file dove preferisci.
- Digita APPLOAD, scegli il file e premi Carica.
- Digita il nome del comando: CXTXTCUT.
Per averlo a ogni avvio, aggiungilo alla Raccolta di avvio nella stessa finestra, oppure carica un'intera cartella in una volta con il caricatore facoltativo. Il caricatore facoltativo
Provato in AutoCAD (versione completa). Altri programmi che eseguono AutoLISP potrebbero funzionare, ma non sono stati provati.
Il codice
Testo semplice, niente di nascosto. Copialo in un file chiamato cxtxtcut.lsp oppure scaricalo.
;;; ============================================================================
;;; CXTXTCUT - Cut characters off texts
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxtxtcut
;;; 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
;;; ============================================================================
;; Cut characters off the text of the objects in NAMES.
;; MODE "First" ARG = number of characters to remove at the start
;; MODE "Last" ARG = number of characters to remove at the end
;; MODE "Before" ARG = a string: remove everything up to and including its first occurrence
;; MODE "After" ARG = a string: remove it and everything after its first occurrence
;; MTEXT with its own formatting is left alone. Returns (changed . skipped).
(defun cx:txtcut-run (names mode arg / changed skipped s new p)
(setq changed 0 skipped 0)
(foreach e names
(setq s (cx:text-get e) new s)
(if (and (= (cx:dxf 0 (entget e)) "MTEXT") (cx:text-formatted s))
(setq skipped (1+ skipped))
(progn
(cond
((= mode "First") (setq new (substr s (1+ arg))))
((= mode "Last") (setq new (substr s 1 (max 0 (- (strlen s) arg)))))
((= mode "Before") (if (setq p (cx:find s arg 1)) (setq new (substr s (+ p (strlen arg))))))
((= mode "After") (if (setq p (cx:find s arg 1)) (setq new (substr s 1 (1- p))))))
(if (/= new s)
(progn (cx:text-set e new) (setq changed (1+ changed)))))))
(cons changed skipped))
(defun c:CXTXTCUT ( / *error* cx:sv ss mode arg r)
(setq *error* cx:err)
(if (setq ss (cx:pick "\nSelect texts: " '((0 . "TEXT,MTEXT"))))
(progn
(setq mode (cx:ask-kw "Remove" "First Last Before After" "First"))
(if (member mode '("First" "Last"))
(setq arg (cx:ask-int "How many characters" 1))
(setq arg (cx:ask-str (if (= mode "Before") "Remove everything up to and including" "Remove this text and everything after it") "-")))
(if (and arg (/= arg ""))
(progn
(cx:start '(("CMDECHO" . 0)))
(setq r (cx:txtcut-run (cx:ss->list ss) mode arg))
(princ (strcat "\n" (itoa (car r)) " text(s) changed"
(if (> (cdr r) 0) (strcat ", " (itoa (cdr r)) " formatted MTEXT skipped") "") "."))
(cx:end)))))
(princ))
;;; ---- Shared helpers (used by the command above; identical in every CADXChange tool) ----
(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)))
;; 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))
;; True when an MTEXT string holds format codes other than line breaks.
(defun cx:text-formatted (str / r)
(foreach tk (cx:fmt-tokens str T)
(if (and (= (car tk) 'C) (not (member (cdr tk) '("\\P" "\\p")))) (setq r T)))
r)
;; 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)
;; Replace the text of a TEXT, ATTRIB, ATTDEF or MTEXT.
(defun cx:text-set (ename str / ed out)
(setq ed (entget ename))
(if (= (cx:dxf 0 ed) "MTEXT")
(progn
;; MTEXT stores text in 250-character pieces: 3 groups for the first pieces, 1 for the last
(foreach p ed (if (not (member (car p) '(1 3))) (setq out (cons p out))))
(setq out (reverse out))
(while (> (strlen str) 250)
(setq out (append out (list (cons 3 (substr str 1 250)))) str (substr str 251)))
(setq ed (append out (list (cons 1 str)))))
(setq ed (subst (cons 1 str) (assoc 1 ed) ed)))
(entmod ed)
(entupd ename)
T)
;; 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))
;; Ask for an integer with a default; returns the default on Enter.
(defun cx:ask-int (msg def / v)
(setq v (getint (strcat "\n" msg " <" (itoa def) ">: ")))
(if v v def))
;; Ask for a string (spaces allowed) with a default; "-" means an empty string.
(defun cx:ask-str (msg def / v)
(setq v (getstring T (strcat "\n" msg " <" def ">: ")))
(cond ((= v "") def) ((= v "-") "") (T v)))
;; 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 "\nCXTXTCUT loaded. Type CXTXTCUT to start.")
(princ)
Cronologia delle versioni
Versione 1.0.0 · 27 ottobre 2026
Prima versione.
Ti serve su molti disegni?
TextSync svolge questo tipo di lavoro su un'intera cartella di disegni in un solo passaggio.
TextSyncAltri comandi: Testo
CXNUMNumerare i testi in sequenzaCXTXTADDAggiungere un prefisso o un suffisso a molti testiCXTXTCASECambiare maiuscole e minuscole di molti testiCXTXTREPLTrovare e sostituire in molti testi insiemeCXTXTCLEANPulire spazi e formattazione dei testiCXT2MUnire testi a riga singola in un unico testo multilineaCXM2TScomporre un testo multilinea in testi a riga singolaCXTXTALIGNAllineare i testi a un testo di riferimentoCXTXTSTYLECambiare stile e altezza di molti testiCXTXTCOUNTContare i testi identiciCXTXTSUMSommare i numeri contenuti nei testi