社区 › AutoLISP/Visual LISP 编程技术 › 文字替换函数.

鱼与熊掌 发表于 2015-1-17 23:35:48

文字替换函数.

(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
)

鱼与熊掌 发表于 2015-1-17 23:36:40

正在准备功能.
'("1" "2" "3" "4") '("A" "B" "C" "D"))批量替换.~
抛砖引玉.

鱼与熊掌 发表于 2015-1-18 00:01:01

本帖最后由 鱼与熊掌 于 2015-1-19 00:42 编辑

目测成功了.
(cx-str-rep
    "af1fewr2gdfg6ggd3fgd2gfd4"
    '("1" "2" "3" "4")
    '("A" "B" "C" "D")
)

=>"afAfewrBgdfg6ggdCfgdBgfdD"

;疯狂敛财,没用请不要下载.~

bai2000 发表于 2015-1-18 21:12:06

支持楼主做成能用的lisp，还有最好支持属性块

鱼与熊掌 发表于 2015-1-19 00:15:26

bai2000 发表于 2015-1-18 21:12 static/image/common/back.gif
支持楼主做成能用的lisp，还有最好支持属性块

已经做好了-.-    马上上传..   

鱼与熊掌 发表于 2015-1-19 00:41:02

本帖最后由 鱼与熊掌 于 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:43:56

本帖最后由 鱼与熊掌 于 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")
      )
      )
    )
)
)

davide888 发表于 2017-12-4 11:39:08

我的为什么做不了这效果

LIULISHENG 发表于 2021-4-1 08:13:54

真强大

查看完整版本: 文字替换函数.