Jump to content

Batch Text editor

VisDak

By VisDak
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

VisDak Collaborator

VisDak

Posted
Posted

Hi all,

 

I have an old lisp route the will change the height/rotation/style/text individual and global editor, but i more interest to use is the individual and global editing text, but my problem this will not work on Mtext, only works on Dtext, could any help me to fix this lsp to work on mtext, or if you have any lsp route the will edit globally or individual the will select all text, kindly please provide me :)

 

;;;
;;; Change the text of an entity.
;;;
(defun cht_te ()
 (setq sslen (sslength sset))
 (initget "Globally Individually Retype")
 (setq ans (getkword 
   "\nSearch and replace text.  Individually/Retype/<Globally>:"))
 (setq cht_ot (getvar "texteval"))
 (setvar "texteval" 1)
 (cond 
   ((= ans "Individually")
     (if (= (getvar "popups") 1)
       (progn
         (initget "Yes No")
         (setq ans (getkword "\nEdit text in dialogue? <Yes>:"))
       )
       (setq ans "No")
     )
 
     (while (> sslen 0)
       (redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 3)
       (setq ss (ssadd))
       (ssadd (ssname sset sslen) ss)
       (if (= ans "No") 
         (chgtext ss)
         (command "_.DDEDIT" sn "")
       )
       (redraw sn 1)
     )
   )
   ((= ans "Retype")
     (while (> sslen 0)
       (setq ent (entget(ssname sset (setq sslen (1- sslen)))))
       (redraw (cdr(assoc -1 ent)) 3)
       (prompt (strcat "\nOld text: " (cdr(assoc 1 ent))))
       (setq nt (getstring  T "\nNew text: "))
       (redraw (cdr(assoc -1 ent)) 1)
       (if (> (strlen nt) 0)
         (entmod (subst (cons 1 nt) (assoc 1 ent) ent))
       )
     )
   )
   (T
     (chgtext sset)                  ; Change 'em all
   )
 )
 (setvar "texteval" cht_ot)
)
;;;
;;; The old CHGTEXT command - rudimentary text editor
;;;
;;;
(defun C:CHGTEXT () (chgtext nil))
(defun chgtext (objs / last_o tot_o ent o_str n_str st s_temp 
                      n_slen o_slen si chf chm cont ans)
 (if (null objs)
   (setq objs (ssget))               ; Select objects if running standalone
 )
 (setq chm 0)
 (if objs 
   (progn                   ; If any objects selected
     (if (= (type objs) 'ENAME) 
       (progn
         (setq ent (entget objs))
         (princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
       )
       (if (= (sslength objs) 1)
         (progn
           (setq ent (entget (ssname objs 0)))
           (princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
         )
       )
     )
     (setq o_str (getstring "\nMatch string   : " t))
     (setq o_slen (strlen o_str))
     (if (/= o_slen 0)
       (progn
         (setq n_str (getstring "\nNew string     : " t))
         (setq n_slen (strlen n_str))
         (setq last_o 0 
               tot_o  (if (= (type objs) 'ENAME)
                        1
                        (sslength objs)
                      )
         )
         (while (< last_o tot_o)     ; For each selected object...
           (if (= "TEXT"             ; Look for TEXT entity type (group 0)
                  (cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
             (progn
               (setq chf nil si 1)
               (setq s_temp (cdr (assoc 1 ent)))
               (while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
                 (if (= st o_str)
                   (progn
                     (setq s_temp (strcat 
                                    (if (> si 1)
                                      (substr s_temp 1 (1- si)) 
                                      ""
                                    )
                                    n_str
                                    (substr s_temp (+ si o_slen))
                                  )
                     )
                     (setq chf t)    ; Found old string
                     (setq si (+ si n_slen))
                   )
                   (setq si (1+ si))
                 )
               )
               (if chf 
                 (progn              ; Substitute new string for old
                   ; Modify the TEXT entity
                   (entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
                   (setq chm (1+ chm))
                 )
               )
             )
           )
           (setq last_o (1+ last_o))
         )
       )
       ;; else go on to the next line...
     )
   )
 )
 (if (/= (type objs) 'ENAME)
   (if (/= (sslength objs) 1)        ; Print total lines changed
     (princ (strcat "Changed "
                    (rtos chm 2 0)
                    " text lines."
            )
     )
   )
 )
 (terpri)
)
;;;
;;; Main procedure for manipulating text entities
;;; ARGUMENTS:
;;;   typ   -- Type of operation to perform
;;;   prmpt -- Partial prompt string to insert in standard prompt line
;;;   fld   -- Assoc field to be changed
;;; GLOBALS:
;;;   sset  -- The selection set of text entities
;;;
(defun cht_pe (typ prmpt fld / temp ow nw ent tw sty w hw lw 
                             sslen n sn ssl)
 (if (= (sslength sset) 1)           ; Special case if there is only
                                     ; one entity selected
   ;; Process one entity.
   (cht_p1)
   ;; Else
   (progn
     ;; Set prompt string.
     (cht_sp)
     (if (= nw "List")
       ;; Process List request.
       (cht_pl)
       (if (= nw "Individual")
         ;; Process Individual request.
         (cht_pi)
         (if (= nw "Select")
           ;; Process Select request.
           (cht_ps)
           ;; Else
           (progn
             (if (= typ "Rotation")
               (setq nw (* (/ nw 180.0) pi))
             )
             (if (= (type nw) 'STR)
               (if (not (tblsearch "style" nw))
                 (progn
                   (princ (strcat "\nStyle " nw " not found. "))
                 )
                 (cht_pa)
               )
               (cht_pa)
             )
           )
         )
       )
     )
   )
 )
)
;;;
;;; Change all of the entities in the selection set.
;;;
(defun cht_pa (/ cht_oh temp)
 (setq sslen (sslength sset))
 (setq cht_oh (getvar "highlight"))
 (setvar "highlight" 0)
 (while (> sslen 0)
   (setq temp (ssname sset (setq sslen (1- sslen))))
   (entmod (subst (cons fld nw)
                  (assoc fld (setq ent (entget temp)))
                  ent
           )
   )
   
 )
 (setvar "highlight" cht_oh)
)
;;;
;;; Change one text entity.
;;;
(defun cht_p1 ()
 (setq temp (ssname sset 0))
 (setq ow (cdr(assoc fld (entget temp))))
 (if (= opt "Rotation")
   (setq ow (/ (* ow 180.0) pi))
 )
 (redraw (cdr(assoc -1 (entget temp))) 3)
 (initget 0)
 (if (= opt "Style")
   (setq nw (getstring (strcat "\nNew " prmpt ". <"
                             ow ">: ")))
   (setq nw (getreal (strcat "\nNew " prmpt ". <"
                             (rtos ow 2) ">: ")))
 )
 (if (or (= nw "") (= nw nil))
   (setq nw ow)
 )
 (redraw (cdr(assoc -1 (entget temp))) 1)
 (if (= opt "Rotation")
   (setq nw (* (/ nw 180.0) pi))
 )
 (if (= opt "Style")
   (if (null (tblsearch "style" nw))
     (princ (strcat "\nStyle " nw " not found. "))
     
     (entmod (subst (cons fld nw)
                    (assoc fld (setq ent (entget temp)))
                    ent
             )
     )
   )
   (entmod (subst (cons fld nw)
                  (assoc fld (setq ent (entget temp)))
                  ent
           )
   )
 )
)
;;;
;;; Set the prompt string.
;;;
(defun cht_sp ()
 (if (= typ "Style")
   (progn
     (initget "Individual List New Select ")
     (setq nw (getkword (strcat "\nIndividual/List/Select style/<New "
                                prmpt
                                " for all text entities>: ")))
     (if (or (= nw "") (= nw nil) (= nw "Enter"))
       (setq nw (getstring (strcat "\nNew "
                                   prmpt
                                   " for all text entities: ")))
     )
   )
   (progn
     (initget "List Individual" 1)
     (setq nw (getreal (strcat "\nIndividual/List/<New "
                                prmpt
                                " for all text entities>: ")))
   )
 )
)
;;;
;;; Process List request.
;;;
(defun cht_pl ()
 (setq unctr (1- unctr))
 (setq sslen (sslength sset))
 (setq tw 0)
 (while (> sslen 0)
   (setq temp (ssname sset (setq sslen (1- sslen))))
   (if (= typ "Style")
     (progn
       (if (= tw 0)
         (setq tw (list (cdr(assoc fld (entget temp)))))
         (progn
           (setq sty (cdr(assoc fld (entget temp))))
           (if (not (member sty tw))
             (setq tw (append tw (list sty)))
           )
         )
       )
     )
     (progn
       (setq tw (+ tw (setq w (cdr(assoc fld (entget temp))))))
       (if (= (sslength sset) (1+ sslen)) (setq lw w hw w))
       (if (< hw w) (setq hw w))
       (if (> lw w) (setq lw w))
     )
   )
 )
 (if (= typ "Rotation")
   (setq tw (* (/ tw pi) 180.0)
         lw (* (/ lw pi) 180.0)
         hw (* (/ hw pi) 180.0))
 )
 (if (= typ "Style")
   (progn
     (princ (strcat "\n"
                    typ
                    "(s) -- "))
     (princ tw)
   )
   (princ (strcat "\n"
                    typ
                    " -- Min: "
                    (rtos lw 2)
                    "\t Max: "
                    (rtos hw 2)
                    "\t Avg: "
                    (rtos (/ tw (sslength sset)) 2) ))
 )
)
;;;
;;; Process Individual request.
;;;
(defun cht_pi ()
 (setq sslen (sslength sset))
 (while (> sslen 0)
   (setq temp (ssname sset (setq sslen (1- sslen))))
   (setq ow (cdr(assoc fld (entget temp))))
   (if (= typ "Rotation")
     (setq ow (/ (* ow 180.0) pi))
   )
   (initget 0)
   (redraw (cdr(assoc -1 (entget temp))) 3)
   (if (= typ "Style")
     (progn
       (setq nw (getstring (strcat "\nNew "
                                  prmpt
                                  ". <"
                                  ow ">: ")))
     )
     (progn
       (setq nw (getreal (strcat "\nNew "
                                  prmpt
                                  ". <"
                               (rtos ow 2) ">: ")))
     )
   )
   (if (or (= nw "") (= nw nil))
     (setq nw ow)
   )
   (if (= typ "Rotation")
     (setq nw (* (/ nw 180.0) pi))
   )
   (entmod (subst (cons fld nw)
                  (assoc fld (setq ent (entget temp)))
                  ent
           )
   )
   (redraw (cdr(assoc -1 (entget temp))) 1)
 )
)
;;;
;;; Process the Select option.
;;;
(defun cht_ps ()
 (princ "\nSearch for which Style name?  <*>: ")
 (setq sn  (strcase (getstring))
       n   -1
       nsset (ssadd)
       ssl (1- (sslength sset))
       )
 (if (or (= sn "*") (null sn) (= sn ""))
   (setq nsset sset sn "*")
   (while (and sn (< n ssl))
     (setq temp (ssname sset (setq n (1+ n))))
     (if (= (cdr(assoc 7 (entget temp))) sn)
       (ssadd temp nsset)
     )
   )
 )
 (setq ssl (sslength nsset))  
 (princ "\nFound ")
 (princ ssl)
 (princ " text entities with STYLE of ")
 (princ sn)
 (princ ". ")
)
;;;
;;; The C: function definition.
;;;
(defun c:cht    () (chtxt))
(princ "\n\tc:CHText loaded.  Start command with CHT.")
(princ)

 

Thanks to all

  • 5 weeks later...
gilsoto13 Community Regular

gilsoto13

Posted
Posted
Hi all,

 

I have an old lisp route the will change the height/rotation/style/text individual and global editor, but i more interest to use is the individual and global editing text, but my problem this will not work on Mtext, only works on Dtext, could any help me to fix this lsp to work on mtext, or if you have any lsp route the will edit globally or individual the will select all text, kindly please provide me :)

 

;;;
;;; Change the text of an entity.
;;;
(defun cht_te ()
 (setq sslen (sslength sset))
 (initget "Globally Individually Retype")
 (setq ans (getkword 
   "\nSearch and replace text.  Individually/Retype/<Globally>:"))
 (setq cht_ot (getvar "texteval"))
 (setvar "texteval" 1)
 (cond 
   ((= ans "Individually")
     (if (= (getvar "popups") 1)
       (progn
         (initget "Yes No")
         (setq ans (getkword "\nEdit text in dialogue? <Yes>:"))
       )
       (setq ans "No")
     )

     (while (> sslen 0)
       (redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 3)
       (setq ss (ssadd))
       (ssadd (ssname sset sslen) ss)
       (if (= ans "No") 
         (chgtext ss)
         (command "_.DDEDIT" sn "")
       )
       (redraw sn 1)
     )
   )
   ((= ans "Retype")
     (while (> sslen 0)
       (setq ent (entget(ssname sset (setq sslen (1- sslen)))))
       (redraw (cdr(assoc -1 ent)) 3)
       (prompt (strcat "\nOld text: " (cdr(assoc 1 ent))))
       (setq nt (getstring  T "\nNew text: "))
       (redraw (cdr(assoc -1 ent)) 1)
       (if (> (strlen nt) 0)
         (entmod (subst (cons 1 nt) (assoc 1 ent) ent))
       )
     )
   )
   (T
     (chgtext sset)                  ; Change 'em all
   )
 )
 (setvar "texteval" cht_ot)
)
;;;
;;; The old CHGTEXT command - rudimentary text editor
;;;
;;;
(defun C:CHGTEXT () (chgtext nil))
(defun chgtext (objs / last_o tot_o ent o_str n_str st s_temp 
                      n_slen o_slen si chf chm cont ans)
 (if (null objs)
   (setq objs (ssget))               ; Select objects if running standalone
 )
 (setq chm 0)
 (if objs 
   (progn                   ; If any objects selected
     (if (= (type objs) 'ENAME) 
       (progn
         (setq ent (entget objs))
         (princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
       )
       (if (= (sslength objs) 1)
         (progn
           (setq ent (entget (ssname objs 0)))
           (princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
         )
       )
     )
     (setq o_str (getstring "\nMatch string   : " t))
     (setq o_slen (strlen o_str))
     (if (/= o_slen 0)
       (progn
         (setq n_str (getstring "\nNew string     : " t))
         (setq n_slen (strlen n_str))
         (setq last_o 0 
               tot_o  (if (= (type objs) 'ENAME)
                        1
                        (sslength objs)
                      )
         )
         (while (< last_o tot_o)     ; For each selected object...
           (if (= "TEXT"             ; Look for TEXT entity type (group 0)
                  (cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
             (progn
               (setq chf nil si 1)
               (setq s_temp (cdr (assoc 1 ent)))
               (while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
                 (if (= st o_str)
                   (progn
                     (setq s_temp (strcat 
                                    (if (> si 1)
                                      (substr s_temp 1 (1- si)) 
                                      ""
                                    )
                                    n_str
                                    (substr s_temp (+ si o_slen))
                                  )
                     )
                     (setq chf t)    ; Found old string
                     (setq si (+ si n_slen))
                   )
                   (setq si (1+ si))
                 )
               )
               (if chf 
                 (progn              ; Substitute new string for old
                   ; Modify the TEXT entity
                   (entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
                   (setq chm (1+ chm))
                 )
               )
             )
           )
           (setq last_o (1+ last_o))
         )
       )
       ;; else go on to the next line...
     )
   )
 )
 (if (/= (type objs) 'ENAME)
   (if (/= (sslength objs) 1)        ; Print total lines changed
     (princ (strcat "Changed "
                    (rtos chm 2 0)
                    " text lines."
            )
     )
   )
 )
 (terpri)
)
;;;
;;; Main procedure for manipulating text entities
;;; ARGUMENTS:
;;;   typ   -- Type of operation to perform
;;;   prmpt -- Partial prompt string to insert in standard prompt line
;;;   fld   -- Assoc field to be changed
;;; GLOBALS:
;;;   sset  -- The selection set of text entities
;;;
(defun cht_pe (typ prmpt fld / temp ow nw ent tw sty w hw lw 
                             sslen n sn ssl)
 (if (= (sslength sset) 1)           ; Special case if there is only
                                     ; one entity selected
   ;; Process one entity.
   (cht_p1)
   ;; Else
   (progn
     ;; Set prompt string.
     (cht_sp)
     (if (= nw "List")
       ;; Process List request.
       (cht_pl)
       (if (= nw "Individual")
         ;; Process Individual request.
         (cht_pi)
         (if (= nw "Select")
           ;; Process Select request.
           (cht_ps)
           ;; Else
           (progn
             (if (= typ "Rotation")
               (setq nw (* (/ nw 180.0) pi))
             )
             (if (= (type nw) 'STR)
               (if (not (tblsearch "style" nw))
                 (progn
                   (princ (strcat "\nStyle " nw " not found. "))
                 )
                 (cht_pa)
               )
               (cht_pa)
             )
           )
         )
       )
     )
   )
 )
)
;;;
;;; Change all of the entities in the selection set.
;;;
(defun cht_pa (/ cht_oh temp)
 (setq sslen (sslength sset))
 (setq cht_oh (getvar "highlight"))
 (setvar "highlight" 0)
 (while (> sslen 0)
   (setq temp (ssname sset (setq sslen (1- sslen))))
   (entmod (subst (cons fld nw)
                  (assoc fld (setq ent (entget temp)))
                  ent
           )
   )

 )
 (setvar "highlight" cht_oh)
)
;;;
;;; Change one text entity.
;;;
(defun cht_p1 ()
 (setq temp (ssname sset 0))
 (setq ow (cdr(assoc fld (entget temp))))
 (if (= opt "Rotation")
   (setq ow (/ (* ow 180.0) pi))
 )
 (redraw (cdr(assoc -1 (entget temp))) 3)
 (initget 0)
 (if (= opt "Style")
   (setq nw (getstring (strcat "\nNew " prmpt ". <"
                             ow ">: ")))
   (setq nw (getreal (strcat "\nNew " prmpt ". <"
                             (rtos ow 2) ">: ")))
 )
 (if (or (= nw "") (= nw nil))
   (setq nw ow)
 )
 (redraw (cdr(assoc -1 (entget temp))) 1)
 (if (= opt "Rotation")
   (setq nw (* (/ nw 180.0) pi))
 )
 (if (= opt "Style")
   (if (null (tblsearch "style" nw))
     (princ (strcat "\nStyle " nw " not found. "))

     (entmod (subst (cons fld nw)
                    (assoc fld (setq ent (entget temp)))
                    ent
             )
     )
   )
   (entmod (subst (cons fld nw)
                  (assoc fld (setq ent (entget temp)))
                  ent
           )
   )
 )
)
;;;
;;; Set the prompt string.
;;;
(defun cht_sp ()
 (if (= typ "Style")
   (progn
     (initget "Individual List New Select ")
     (setq nw (getkword (strcat "\nIndividual/List/Select style/<New "
                                prmpt
                                " for all text entities>: ")))
     (if (or (= nw "") (= nw nil) (= nw "Enter"))
       (setq nw (getstring (strcat "\nNew "
                                   prmpt
                                   " for all text entities: ")))
     )
   )
   (progn
     (initget "List Individual" 1)
     (setq nw (getreal (strcat "\nIndividual/List/<New "
                                prmpt
                                " for all text entities>: ")))
   )
 )
)
;;;
;;; Process List request.
;;;
(defun cht_pl ()
 (setq unctr (1- unctr))
 (setq sslen (sslength sset))
 (setq tw 0)
 (while (> sslen 0)
   (setq temp (ssname sset (setq sslen (1- sslen))))
   (if (= typ "Style")
     (progn
       (if (= tw 0)
         (setq tw (list (cdr(assoc fld (entget temp)))))
         (progn
           (setq sty (cdr(assoc fld (entget temp))))
           (if (not (member sty tw))
             (setq tw (append tw (list sty)))
           )
         )
       )
     )
     (progn
       (setq tw (+ tw (setq w (cdr(assoc fld (entget temp))))))
       (if (= (sslength sset) (1+ sslen)) (setq lw w hw w))
       (if (< hw w) (setq hw w))
       (if (> lw w) (setq lw w))
     )
   )
 )
 (if (= typ "Rotation")
   (setq tw (* (/ tw pi) 180.0)
         lw (* (/ lw pi) 180.0)
         hw (* (/ hw pi) 180.0))
 )
 (if (= typ "Style")
   (progn
     (princ (strcat "\n"
                    typ
                    "(s) -- "))
     (princ tw)
   )
   (princ (strcat "\n"
                    typ
                    " -- Min: "
                    (rtos lw 2)
                    "\t Max: "
                    (rtos hw 2)
                    "\t Avg: "
                    (rtos (/ tw (sslength sset)) 2) ))
 )
)
;;;
;;; Process Individual request.
;;;
(defun cht_pi ()
 (setq sslen (sslength sset))
 (while (> sslen 0)
   (setq temp (ssname sset (setq sslen (1- sslen))))
   (setq ow (cdr(assoc fld (entget temp))))
   (if (= typ "Rotation")
     (setq ow (/ (* ow 180.0) pi))
   )
   (initget 0)
   (redraw (cdr(assoc -1 (entget temp))) 3)
   (if (= typ "Style")
     (progn
       (setq nw (getstring (strcat "\nNew "
                                  prmpt
                                  ". <"
                                  ow ">: ")))
     )
     (progn
       (setq nw (getreal (strcat "\nNew "
                                  prmpt
                                  ". <"
                               (rtos ow 2) ">: ")))
     )
   )
   (if (or (= nw "") (= nw nil))
     (setq nw ow)
   )
   (if (= typ "Rotation")
     (setq nw (* (/ nw 180.0) pi))
   )
   (entmod (subst (cons fld nw)
                  (assoc fld (setq ent (entget temp)))
                  ent
           )
   )
   (redraw (cdr(assoc -1 (entget temp))) 1)
 )
)
;;;
;;; Process the Select option.
;;;
(defun cht_ps ()
 (princ "\nSearch for which Style name?  <*>: ")
 (setq sn  (strcase (getstring))
       n   -1
       nsset (ssadd)
       ssl (1- (sslength sset))
       )
 (if (or (= sn "*") (null sn) (= sn ""))
   (setq nsset sset sn "*")
   (while (and sn (< n ssl))
     (setq temp (ssname sset (setq n (1+ n))))
     (if (= (cdr(assoc 7 (entget temp))) sn)
       (ssadd temp nsset)
     )
   )
 )
 (setq ssl (sslength nsset))  
 (princ "\nFound ")
 (princ ssl)
 (princ " text entities with STYLE of ")
 (princ sn)
 (princ ". ")
)
;;;
;;; The C: function definition.
;;;
(defun c:cht    () (chtxt))
(princ "\n\tc:CHText loaded.  Start command with CHT.")
(princ)

 

Thanks to all

 

I posted it several times already..... This routine allows you to change all those things from selected Text, mtext and attributes...

 

It works through dialog box.

dt2.jpg

dt3.jpg

dt.zip

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...