求改钢筋符号代码修改。谢谢
图纸钢筋符号显示是:一级钢是%%129;二级钢是%%130;三级钢是%%132与%%133;而我的字体:I级钢是%%130;II级钢是%%131;III级钢是%%132。
意思就是:图纸中的钢筋符号一次替换成我字体的相应钢筋符号。。这个代码完整的要怎么写呢各位高手。。帮帮忙。谢谢
当然用查找替换可以。。但是用代码更快哈~~麻烦哪位老大帮偶改改谢谢
(vl-load-com)
(defun c:test( / ss n ent obj txt)
(if (setq ss (ssget '((0 . "*TEXT") (1 . "*%%128*"))))
(repeat (setq n (sslength ss))
(setq ent (ssname ss (setq n (1- n))))
(setq obj (vlax-ename->vla-object ent))
(setq txt (vla-get-textstring obj))
(while (wcmatch txt "*%%128*")
(setq txt (VL-STRING-SUBST "%%129" "%%128" txt))
)
(vla-put-textstring obj txt)
)
)
(princ)
)
本帖最后由 highflybird 于 2011-12-23 17:11 编辑
楼主是不是这个意思?
(vl-load-com)
(defun c:test (/ ss n ent obj txt)
(if (setq ss (ssget '((0 . "*TEXT") (1 . "*%%128*,*%%129*,*%%130*,*%%131*,*%%133*"))))
(repeat (setq n (sslength ss))
(setq ent (ssname ss (setq n (1- n))))
(setq obj (vlax-ename->vla-object ent))
(setq txt (vla-get-textstring obj))
(cond
((wcmatch txt "*%%128*")
(setq txt (ReplaceText "%%129" "%%128" txt))
)
((wcmatch txt "*%%129*")
(setq txt (ReplaceText "%%130" "%%129" txt))
)
((wcmatch txt "*%%130*")
(setq txt (ReplaceText "%%131" "%%130" txt))
)
((wcmatch txt "*%%131*")
(setq txt (ReplaceText "%%132" "%%131" txt))
)
((wcmatch txt "*%%133*")
(setq txt (ReplaceText "%%132" "%%133" txt))
)
)
(vla-put-textstring obj txt)
)
)
(princ)
)
(defun ReplaceText (NewStr oldstr string / txt)
(setq txt string)
(while (vl-string-search oldstr txt)
(setq txt (VL-STRING-SUBST NewStr oldstr txt))
)
txt
)
哪位大侠路过滴给改改谢谢 如果只是以上三个就好办,批量的麻烦 (defun c:gjth()
(reptext "%%133" "%%132")
(reptext "%%130" "%%131")
(reptext "%%129" "%%130")
;下面用于老版TSSD2010
(reptext "\134U+233" "%%13")
;下面用于最新版TSSD2010
(reptext "" "%%130")
(reptext "" "%%131")
(reptext "" "%%132")
(reptext "" "%%133"))
;;; (reptext <要找的文字> <替换成的文字>)
(defun reptext (oldch newch / ss ssl ct0 edata etext txtln subln ct1 ct2 schct newtext)
(setq ss (ssget "x" '((0 . "*TEXT")))) ;选择文字
(if ss
(progn
(setq ssl (sslength ss)
ct0 0
ct1 0
ct2 0
subln (strlen oldch)
)
(while (< ct0 ssl)
(setq edata (entget (ssname ss ct0))
etext (cdr (assoc 1 edata))
txtln (strlen etext)
schct 1
newtext ""
)
(while (<= schct txtln)
(setq newtext
(strcat newtext
(if (= (setq readch (substr etext schct subln)) oldch)
(setq ct1 (1+ ct1)
schct (+ schct subln)
newch newch
)
(progn
(setq schct (1+ schct))
(substr readch 1 1)
)
)
)
)
)
(if (/= etext newtext)
(progn
(entmod (subst (cons 1 newtext) (assoc 1 edata) edata))
(setq ct2 (1+ ct2))
)
)
(setq ct0 (1+ ct0))
)
)
)
)
上面的代码用于老版的TSSD2010和最新板TSSD2010测试通过,由于没有您的字体,没有测试前面的,注意不要改变代码位置 抬高物价,是通货膨胀么 本帖最后由 尘缘一生 于 2019-4-25 09:24 编辑
夏生生 发表于 2011-12-23 16:07
改成了选取部分换钢筋的程序!
;;说明:【选取方式】批量替换钢筋全为三级钢
(defun c:gjth( / ss p n edata etext txtln subln n1 n2 schct newtext stys)
(setq ss (ssget )) ;选择文字与实体整个体即可
;;; (reptext <要找的文字> <替换成的文字>)
(defun reptext (oldch newch)
(setq p (sslength ss)
n 0
n1 0
n2 0
subln (strlen oldch)
)
(while (< n p)
(setq edata(entget (ssname ss n)) stys(cdr (assoc 0 edata)))
(if (OR (= stys "TEXT") (= stys "MTEXT"))
(progn
(setq etext (cdr (assoc 1 edata)) txtln (strlen etext) schct 1 newtext "")
(while (<= schct txtln)
(setq newtext
(strcat newtext
(if (= (setq readch (substr etext schct subln)) oldch)
(setq n1 (1+ n1)
schct (+ schct subln)
newch newch
)
(progn
(setq schct (1+ schct))
(substr readch 1 1)
)
)
)
)
)
(if (/= etext newtext)
(progn
(entmod (subst (cons 1 newtext) (assoc 1 edata) edata))
(setq n2 (1+ n2))
)
)
)
)
(setq n (1+ n))
)
)
(reptext "%%133" "%%132");;;;四级筋变三级筋
;;;;;;(reptext "%%130" "%%131");;;;; 一级筋变二级筋
(reptext "%%131" "%%132");;;;; 二级筋变三级筋
(reptext "%%130" "%%132");;;;; 一级筋变三级筋
(reptext "%%129" "%%130");;;;;129变一级筋
;下面用于老版TSSD2010
(reptext "\134U+233" "%%13")
;下面用于最新版TSSD2010
(reptext "" "%%130")
(reptext "" "%%132")
(reptext "" "%%132")
(reptext "" "%%132")
)
;;说明:选取方式批量替换钢筋--结束
页:
[1]