文字加前后缀
(DEFUN C:LT005 ()(setq qh (getint "\n======加前缀输入（1）,======加后缀输入（2）,<1>："))
(if (= qh nil)(setq qh 1))
(princ "\nselect object:")
(setq ss (ssget))
(setq str (getstring "\n请输入要加的文字:"))
(setq n (sslength ss))
(setq k 0 )
(while (< k n)
(setq name (ssname ss k))
(setq a (entget name))
(setq t1 (assoc '0 a))
(setq t1 (cdr t1))
(if (= t1 "TEXT") (PROGN
(setq h (assoc '1 a)) 完了？好像没结束吧？ 好像没结束吧 好像没结束吧 执行之后CAD未响应，这插件哪位大神再优化下（测试版本：CAD2010）
(DEFUN C:kk ()
(setq qh (getint "\n======加前缀输入（1）,======加后缀输入（2）,<1>："))
(if (= qh nil)(setq qh 1))
(princ "\nselect object:")
(setq ss (ssget))
(setq str (getstring "\n请输入要加的文字:"))
(setq n (sslength ss))
(setq k 0 )
(while (< k n)
(setq name (ssname ss k))
(setq a (entget name))
(setq t1 (assoc '0 a))
(setq t1 (cdr t1))
(if (= t1 "TEXT") (PROGN
(setq h (assoc '1 a))
)
)
)
) 已经有网友提供相应的了，版权归原发帖人！
;; 前缀后缀
(defun c:qaa ()
(setq qhz (getint "\n加前缀-1,加后缀-2,减前缀-3,减后缀-4,<1>"))
(if (= qhz nil)
(setq qhz 1)
)
(if (or (= qhz 1) (= qhz 2))
((princ "\n选择修改对象:")
(setq s (ssget))
(setq str (getstring "\n输入要加的字:"))
(setq n (sslength s))
(setq k 0)
(while (< k n)
(setq name (ssname s k))
(setq a (entget name))
(setq t1 (assoc '0 a))
(setq t1 (cdr t1))
(if (= t1 "TEXT")
(PROGN
(setq h (assoc '1 a))
(setq hh (cdr h))
(if (= qhz 1)
(setq str1 (strcat str hh))
)
(if (= qhz 2)
(setq str1 (strcat hh str))
)
(setq h1 (cons 1 str1))
;(if (= str "") (setq h1 h))
(setq a (subst h1 h a))
(entmod a)
)
)
(setq k (+ k 1))
)
)
)
(if (and (/= c 1) (/= c 2))
((princ "\n选择修改对象:")
(setq s (ssget))
(princ "一个汉字占两个字符")
(setq nnn (getint "输入要减的字符数量<1>:"))
(if (= nnn nil)
(setq nnn 1)
)
(setq n (sslength s))
(setq k 0)
(while (< k n)
(setq name (ssname s k))
(setq a (entget name))
(setq t1 (assoc '0 a))
(setq t1 (cdr t1))
(if (= t1 "TEXT")
(PROGN
(setq h (assoc '1 a))
(setq hh (cdr h))
(setq len0 (strlen hh)
len1 (- len0 nnn)
)
(if (= qhz 3)
(setq str1 (substr hh (+ 1 nnn) len1))
)
(if (= qhz 4)
(setq str1 (substr hh 1 len1))
)
(setq h1 (cons 1 str1))
;(if (= str "") (setq h1 h))
(setq a (subst h1 h a))
(entmod a)
)
)
(setq k (+ k 1))
)
)
)
)
;; 前缀后缀
;; =================================
;仿贱人前后缀
;(qianhouzhuiset)
(defun qianhouzhuiset ( / get_date lst_str str file f dcl_id dd);通过对话框设置参数
(defun get_date ()(mapcar 'get_tile(list "qz" "qztx" "hz" "hztx")))
(setq lst_str '(
"qianhouzhuidcl:dialog {label = \"前后缀\" ;"
" :boxed_column {label = \"选项\" ;"
" :row{:toggle {key = \"qz\" ;label = \"前缀\" ;}"
" :edit_box {edit_width = 30 ;key = \"qztx\" ;}}"
" :row{:toggle {key = \"hz\" ;label = \"后缀\" ;}"
" :edit_box {edit_width = 30 ;key = \"hztx\" ;}}"
" }"
" :row{: button{label = \"加前后缀\";key = \"button1\";}"
" : button{label = \"删前后缀\";key = \"button2\";}"
" cancel_button;}"
" :text {label = \"by mike\" ;}}"
)
)
(setq file (vl-filename-mktemp "DclTemp.dcl"))
(setq f (open file "w"))
(foreach str lst_str(princ "\n" f)(princ str f))
(close f)
(or qianhouzhuidata(setq qianhouzhuidata(list "1" "1）" "0" "。")));全局变量
(setq dcl_id (load_dialog file))
(new_dialog "qianhouzhuidcl" dcl_id "3" Pset_qhzdate)
(mapcar '(lambda (x y) (set_tile x y))(list "qz" "qztx" "hz" "hztx")qianhouzhuidata)
(action_tile "button1" "(setq qianhouzhuidata(get_date))(setq Pset_qhzdate(done_dialog 1)))")
(action_tile "button2" "(setq qianhouzhuidata(get_date))(setq Pset_qhzdate(done_dialog 2)))")
(setq dd (start_dialog))
(unload_dialog dcl_id)
(vl-file-delete file);删除临时dcl文件
(cond((= 1 dd)(cons "+" qianhouzhuidata))((= 2 dd)(cons "-" qianhouzhuidata))(t nil))
)
(defun c:qaaa()(setq qhzset(qianhouzhuiset))(qianhouzhui qhzset)(princ))
;qhzset固定格式，对话框输出的
(defun qianhouzhui(qhzset / qhz- data ss txtls qz hz)
(defun qhz- (str str1 str2)
(if(wcmatch str (strcat str1 "*"))(setq str(substr str(1+(strlen str1)))))
(if(wcmatch str (strcat "*"str2))(setq str(substr str 1(- (strlen str)(strlen str2)))))
str
)
(sssetfirst);防已选误操作
(setq ss0(ssadd))
(while
(setq ss(ssget ":S" '((0 . "*TEXT")
(-4 . "<NOT")(1 . "*\\P*")(-4 . "NOT>")
(-4 . "<NOT")(1 . "*\n*")(-4 . "NOT>")
(-4 . "<NOT")(1 . "*\t*")(-4 . "NOT>")
)));只有一行的文字
(setq ss(mapcar 'cadr (ssnamex ss)))
(setq ss(vl-remove-if '(lambda(x)(/= (type x) 'ENAME))ss));变图元名表
(setq ss(vl-remove-if '(lambda(x)(ssmemb x ss0))ss));不在ss0的
(cond(ss(mapcar '(lambda(x)(setq ss0(ssadd x ss0))) ss);加入ss0
(setq ss(mapcar 'vlax-ename->vla-object ss));对象集
(setq txtls(mapcar 'vla-get-textstring ss));字符串表
(setq qz(if(= "1"(nth 1 qhzset))(nth 2 qhzset)""))
(setq hz(if(= "1"(nth 3 qhzset))(nth 4 qhzset)""))
(if(= "+" (car qhzset))
(setq txtls(mapcar '(lambda(x)(strcat qz x hz))txtls))
(setq txtls(mapcar '(lambda(x)(qhz- x qz hz))txtls))
)
(mapcar '(lambda(x y)(vla-put-textstring x y))ss txtls)
)
)
)
)
小毛草 发表于 2023-3-5 12:21
已经有网友提供相应的了，版权归原发帖人！
;; 前缀后缀
感谢分享，测试ok，很适合批次文本修改使用。
页:
[1]