需要帮助才能更改脚本o
你好我需要一个脚本在文本字符串中的最后一个数字处添加一个值“n”。如果可能的话，这也适用于块和多重选择。
例子：
TT-1530->TT-1890
10-TT-1530->10-TT-1890
你能帮我吗？
我不知道如何编辑或写脚本，但我在网上找到了两个脚本
第一个脚本：
这个脚本在字符串的第一个数字处添加值，而不是在最后，并且不在块上工作。
(defun DXF (code elist)
; finds the association pair, strips 1st element
(cdr (assoc code elist))
)
(princ)
(defun c:CEL (/ me ce hl rm bm bmoff dprec i j en ed ety lay ss len etxt wtxt elen pretxt txt posttxt ex ey ez ntxt nz old new nxyz mod)
(prompt "\n\nChange Bench Mark for Annotation Textv2.2 2/10/93")
;
(setq me (getvar "menuecho"))
(setvar "menuecho" 0)
(setq ce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq rm (getvar "regenmode"))
(setvar "regenmode" 0)
(setq bm (getvar "blipmode"))
(setvar "blipmode" 0)
;Prompt for bench mark offset
(print)
(initget 1)
(setq bmoff (getreal "\nEnter value for bench mark offset, <0> to exit? "))
(if (/= bmoff 0)
(progn
(initget 1)
(setq dprec (getint "Enter decimal precision for annotation? "))
(prompt "\n\nBench Mark Offset value: ")(princ bmoff)
(prompt "\nDecimal precision on annotation: ")(princ dprec)
;Locate text to change and select all text on that layer
; prompt user to pick text entity
;Create selection set of all annotation text entities
(setq ss (ssget (list (cons 0 "TEXT"))))
;Process text and modify based on bench mark offset
(setq i 0
mod 0)
(setq len (sslength ss))
(while (< i len)
(setq en (ssname ss i)
ed (entget en)
txt ""
pretxt ""
posttxt ""
noproc 0)
(setq etxt (dxf 1 ed))
(setq wtxt etxt)
(setq ex (car (dxf 10 ed)))
(setq ey (cadr (dxf 10 ed)))
(setq ez (caddr (dxf 10 ed)))
(setq elen (strlen etxt))
(setq j 1)
; Locate PRE-text
(if (not (member (substr etxt j 1) '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" ".")))
(progn
(while (< j(1+ elen))
(if (not (member (setq cc (substr etxt j 1)) '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" ".")))
(setq j (1+ j))
(progn
(setq pretxt (substr etxt 1 (- j 1)))
(setq etxt (substr etxt j elen))
(setq j (+ elen 2))
(setq noproc 1)
);progn
);if
);while
(if (= j (1+ elen))
(setq noproc 1)
);if
);progn
(setq pretxt "")
);if
;
; Locate text to modify
;
(setq j 1)
(setq elen (strlen etxt))
(if (> elen 0)
(progn
(while (< j(1+ elen))
(if (member (setq cc (substr etxt j 1)) '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" "."))
(setq j (1+ j))
(progn
(if (member cc '("\"" "\'"))
(progn
(setq noproc 1)
(setq j (1+ elen))
);progn
(progn
(setq txt (substr etxt 1 (- j 1)))
(setq posttxt (substr etxt j elen))
(setq j (1+ elen))
);progn
);if
);progn
);if
(if (= j elen)
(progn
(setq txt etxt)
(setq posttxt "")
);progn
);if
);while
);progn
);if
;
; Add BM Change
;
(if (= noproc 0)
(progn
(setq ztxt (rtos (+ (atof txt) bmoff) 2 dprec))
(setq ntxt (strcat pretxt ztxt posttxt))
(setq nz (+ ez bmoff))
;
;Modifying entity data
;
(setq old (assoc 1 ed))
(setq new (cons 1 ntxt)) ; Text value
(setq ed (subst new old ed))
(setq ed (subst new old ed))
(entmod ed)
(setq mod (1+ mod))
);progn
(progn
);progn
);if
(setq i (+ i 1))
);while
) ;progn
;
; result to BM OFFSET = 0
;
(prompt "\n\nProgram terminated.")
);endif
(princ "\n\nThere were ")(princ len)(princ " entities processed and ")
(princ mod)(princ " entities modified.")
; reset system variables
(setvar "regenmode" rm)
(setvar "blipmode" bm)
(setvar "cmdecho" ce)
(setvar "menuecho" me)
(princ)
) ;End of CEL
第二个脚本：
此脚本在字符串上的每个数字处添加值，并添加小数点（不适用于块）
(defun c:Text_Inc (/ *error* ParseNumbers uFlag ss)
(vl-load-com)
;; Lee Mac ~ 10.03.10
(defun *error* (msg)
(setvar 'NOMUTT 0)
(and uFlag (vla-EndUndoMark *doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(defun ParseNumbers (str / lst Num Aph x rtn)
;; Lee Mac ~ 20.09.09
(setq lst (vl-string->list str) Num "" Aph "")
(while (setq x (car lst))
(setq lst (cdr lst))
(cond ( (and (/= "" Num) (= 46 x))
(setq Num (strcat Num (chr x))))
( (< 47 x 58)
(setq Num (strcat Num (chr x))
rtn (cons Aph rtn) Aph ""))
(t (setq Aph (strcat Aph (chr x))
rtn (cons (read Num) rtn) Num ""))))
(vl-remove nil
(vl-remove "" (reverse (cons Aph (cons (read Num) rtn))))))
(setq *inc* (cond (*inc*) (1.0)))
(setq *inc* (cond ((getreal (strcat "\nSpecify Increment <"
(vl-princ-to-string *inc*) "> : ")))
(*inc*)))
(setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))))
(setvar 'NOMUTT 1)
(princ "\nSelect Text to Increment <All> : ")
(if (or (ssget "_:L" '((0 . "MTEXT,TEXT")))
(ssget "_X" '((0 . "MTEXT,TEXT"))))
(progn
(setq uFlag (not (vla-StartUndoMark *doc)))
(vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))
(vla-put-TextString obj
(apply (function strcat)
(mapcar
(function
(lambda (x) (if (vl-position (type x) '(INT REAL))
(rtos (+ x *inc*) (getvar 'LUNITS) 3) x)))
(ParseNumbers (vla-get-TextString obj))))))
(vla-delete ss)
(setq uFlag (vla-EndUndoMark *doc))))
(setvar 'NOMUTT 0)
(princ)) 只有当分隔符类似于您的示例中的“-”并且根本没有经过测试时。。。
(defun c:lastattnumaddition ( / f-MR numstrchk ss n i bl str splitstr lastnumber pref newpref newstr attlst )
(vl-load-com)
(defun f-MR ( d s / d1 dl k ss c pl z l )
(while (and (setq d1 (substr d 1 1)) (/= d1 ""))
(setq d (substr d 2))
(setq dl (cons d1 dl))
)
(foreach d1 dl
(setq k -1 ss s)
(while (and (setq c (substr ss 1 1)) (/= c ""))
(setq ss (substr ss 2))
(setq k (1+ k))
(if (= c d1)
(setq pl (cons k pl))
)
)
)
(if pl
(progn
(setq pl (vl-sort pl '<))
(foreach p pl
(if (null z)
(setq z 1)
)
(setq l (cons (substr s z (1+ (- p z))) l))
(setq z (+ p 2))
)
(setq l (cons (substr s z) l))
(vl-remove "" (reverse l))
)
s
)
)
(defun numstrchk ( s / ss ssl )
(while (and (setq ss (substr s 1 1)) (/= ss ""))
(setq s (substr s 2))
(setq ssl (cons ss ssl))
)
(vl-every '(lambda ( x ) (vl-position x '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))) ssl)
)
(prompt "\nSelect blocks to perform operation on...")
(setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
(if ss
(progn
(initget 3)
(setq n (getint "\nSpecify number for addition to last number of blocks attributes : "))
(repeat (setq i (sslength ss))
(setq bl (ssname ss (setq i (1- i))))
(foreach att (append (vlax-invoke (vlax-ename->vla-object bl) 'getattributes) (vlax-invoke (vlax-ename->vla-object bl) 'getconstantattributes))
(if (not (vl-position att attlst))
(progn
(setq str (vla-get-textstring att))
(if (and
(/= str "")
(or
(and (listp (f-MR "/" str)) (listp (f-MR "-" (car (f-MR "/" str)))) (numstrchk (last (f-MR "-" (car (f-MR "/" str))))))
(and (listp (f-MR "/" str)) (= (type (f-MR "-" (car (f-MR "/" str)))) 'str) (numstrchk (f-MR "-" (car (f-MR "/" str)))))
(and (= (type (f-MR "/" str)) 'str) (listp (f-MR "-" str)) (numstrchk (last (f-MR "-" str))))
)
)
(progn
(setq splitstr (f-MR "/" str))
(if (listp splitstr)
(progn
(setq pref (car splitstr))
(setq pref (f-MR "-" pref))
(if (listp pref)
(progn
(setq lastnumber (last pref))
(setq lastnumber (itoa (+ (atoi lastnumber) n)))
(setq pref (reverse (cons lastnumber (cdr (reverse pref)))))
(setq newpref "")
(foreach s (reverse pref)
(setq newpref (strcat s "-" newpref))
)
(setq newpref (vl-string-right-trim "-" newpref))
(setq newstr (strcat newpref "/" (last splitstr)))
)
(progn
(setq lastnumber (itoa (+ (atoi pref) n)))
(setq newstr (strcat lastnumber "/" (last splitstr)))
)
)
)
(progn
(setq splitstr (f-MR "-" splitstr))
(if (listp splitstr)
(progn
(setq lastnumber (last splitstr))
(setq lastnumber (itoa (+ (atoi lastnumber) n)))
(setq splitstr (reverse (cons lastnumber (cdr (reverse splitstr)))))
(setq newstr "")
(foreach s (reverse splitstr)
(setq newstr (strcat s "-" newstr))
)
(setq newstr (vl-string-right-trim "-" newstr))
)
)
)
)
(vla-put-textstring att newstr)
(setq attlst (cons att attlst))
)
)
)
)
)
)
)
)
(princ)
)
M.R。 谢谢你的回答。
我刚才测试了一下，发现了这个错误：
; 错误：没有函数定义：VLA-PUT-TEXTSTREING
ps：有没有机会让它也适用于正常的文本字符串？
对不起，我英语不好。
安德里亚。 我看到那个打字错误。。。似乎你在我第一次发布时就抓到了代码，然后我纠正了。。。也许现在再次尝试抓取。。。你说的普通文本字符串是什么意思？这将是非常相似的，但我建议另一个lisp基于我的帖子。。。现在自己试穿，你有一些东西要开始。。。如果你被困在某个地方，请报告并发布代码以进行修订。。。
M、 R。 我从不用Lisp程序的语言写作，我很快就会开始。我只写了C，C++，Java，Visual Basic，HTML。对于字符串，我认为文本包含字母、数字和符号。我必须编辑文本框和框的属性。原谅误解。
你知道好的lisp手册读吗？还是学习指南？
安德莉亚 以下是最近的类似请求：
https://www.theswamp.org/index.php?topic=51989.0
您好，M.R。 你好
马尔科·里巴。
我今天试了一下你的Script，我可以看到：
-工作http://i.imgur.com/B1r5Qbc.png
-不要在上工作http://i.imgur.com/y9stmlf.png
-选择“多个对象”时，脚本仅更改最后选择的对象。
很抱歉再次打扰你，你能再帮我一次吗？
我认为我不能及时阅读和学习手册，我需要这个宏才能工作。
谢谢你。
亲切的问候
安德莉亚 你好
马尔科·里巴。
我今天试了一下你的Script，我可以看到：
-关于“块参考”的工作
-不要处理“文本”
-选择“多个对象”时，脚本仅更改最后选择的对象。
很抱歉再次打扰你，你能再帮我一次吗？
我认为我不能及时阅读和学习手册，我需要这个宏才能工作。
谢谢你。
亲切的问候
安德莉亚 我已经更新了我以前的代码，并尝试此文本。。。
（defun c:lasttxtnumaddition（/f-MR ss n i txt str splitstr lastnumber pref newpref newstr）（vl load com）（defun f-MR（d s/d1 dl k ss c pl z l）（while（and（setq d1（substr d 1））（/=d1“”）（setq d（substr d 2））（setq dl（cons d1 dl））（foreach d1 dl（setq k-1 ss s）（while（and（setq c（substr ss 1））（/=c“”）（setq ss（substr ss 2））（setq k（1+k））（if（=c d1）（setq pl（cons k pl））））（if pl（progn（setq pl（vl sort pl）' Andrea，你能上传DWG显示之前的情况，以及DWG显示之后的情况应该是什么*。lsp do。。。您可以在几个块上手动创建，但DWG应该显示您需要什么和*。lsp没有按预期进行。。。
页:
[1]
2