批处理文本编辑器
大家好，我有一个旧的lisp路径，它将更改高度/旋转/样式/文本单个和全局编辑器，但我更感兴趣的是使用单个和全局编辑文本，但我的问题是，这将不适用于多行文字，只适用于Dtext，有什么可以帮我修复此lsp以处理多行文字，或者如果您有任何lsp路径，它将全局编辑或单个，它将选择所有文本，请提供给我
;;;
;;; 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 (getstringT "\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)
谢谢大家
我已经贴了好几次了。。。。。此例程允许您更改选定文本、多行文字和属性中的所有内容。。。
它通过对话框工作。
dt。拉链
页:
[1]