文字替换函数.
(defun cx-str-th (etext old new)(setqthln (strlen old)
runstr ""
)
(while (> (strlen etext) 0)
(if(= old (substr etext 1 thln))
(progn
(setq runstr (strcat runstr new))
(setq etext (substr etext (1+ thln)))
)
(progn
(setq runstr (strcat runstr (substr etext 1 1)))
(setq etext (substr etext 2))
)
)
)
runstr
) 正在准备功能.
'("1" "2" "3" "4") '("A" "B" "C" "D"))批量替换.~
抛砖引玉. 本帖最后由 鱼与熊掌 于 2015-1-19 00:42 编辑
目测成功了.
(cx-str-rep
"af1fewr2gdfg6ggd3fgd2gfd4"
'("1" "2" "3" "4")
'("A" "B" "C" "D")
)
=>"afAfewrBgdfg6ggdCfgdBgfdD"
;疯狂敛财,没用请不要下载.~
支持楼主做成能用的lisp,还有最好支持属性块 bai2000 发表于 2015-1-18 21:12 static/image/common/back.gif
支持楼主做成能用的lisp,还有最好支持属性块
已经做好了-.- 马上上传.. 本帖最后由 鱼与熊掌 于 2015-1-19 00:49 编辑
画里面索引这种属性块时,有时候需要重新编号,那么就会非常麻烦.
或者排号的时候,比较麻烦,现在推出这个功能, 我觉得还行.
属于代码的引用实例.包括函数.
cx-reptext
;功能,替换文字或者属性块的文字.
;参数 ss 选择集或者图元表.
;oldstr 旧文字 支持单文本替换和集体替换如 "1" 或者'("1" "2" "3" "4")
;newstr新文字,同上 "A"或者'("A" "B" "C" "D")
;工作中可能需要1>A 2>B 3>C 4>D.
那么使用传统的替换方式可能最后的结果需要多重转换,也就是变量转换的问题.
比如A=>1
后来1又被替换成C,最后造成结果不正确代码太长不好维护.
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
本帖最后由 鱼与熊掌 于 2015-1-19 00:47 编辑
;跟帖伪源码.
;上方演示图的伪源码.
;另外为替换文字函数的函数,支持属性块.
;函数Etype,Dxf,entmod,借用一部分E派函数.;功能,索引加
(defun c:jsy (/ *cx_jsyint attlst minx slst ss)
;;;(setq ss (ssget ))
(if (null *cx_jsyint)
(setq *cx_jsyint 1)
)
(while (progn
(setq ss
(cx-ssget (strcat "选择递增块,起始值:" (itoa *cx_jsyint) "\n")
(CX-LST+STR (CX-RANGE-STRNUM 1 100) " ")
'((0 . "INSERT"))
)
)
(cond
((=
'str
(type ss)
)
(setq *cx_jsyint (atoi ss))
t
)
(ss
nil
)
(t t)
)
)
)
(if ss
(progn
(setq slst (cx-ss2en ss))
(setq attlst (mapcar '(lambda (x) (cx-Get-Attstr x)) slst))
(setq attlst (apply 'append attlst))
(setq attlst (VL-REMOVE-IF-NOT 'CX-STRISINT attlst))
(setq attlst (mapcar 'atoi attlst))
(setq minx (apply 'min attlst))
(cx-reptext
slst
(CX-RANGE-STRNUM minx (+ minx 3))
(CX-RANGE-STRNUM *cx_jsyint (+ *cx_jsyint 3))
)
(setq *cx_jsyint (+ 4 *cx_jsyint))
)
)
)
;批量替换文本.
(defun CX-reptext (SS oldch newch / ct0 ct1
ct2 edata etext newtext obj readch
schct ssl subln txtln
)
(if (/= 'list (type ss))
(setq ss (cx-ss2en ss))
)
(foreach x ss
(cond
((cx-Etype x "*TEXT")
(cx-entmod x 1 (cx-str-th newch oldch (cx-dxf 1 x)))
)
((cx-Etype x "INSERT")
(setq obj (zvla x))
(mapcar '(lambda(att)
;(cons (vla-get-TagString att) (vla-get-TextString att))
(vla-put-TextString
att
(cx-str-th newch
oldch
(vla-get-TextString
att
)
)
)
)
(vlax-invoke obj "GetAttributes")
)
)
)
)
)
我的为什么做不了这效果 真强大
页:
[1]