设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 求改钢筋符号代码修改。谢谢
返回列表 发新帖
查看: 3346|回复: 11

求改钢筋符号代码修改。谢谢

[复制链接]
flytoday
发表于 2011-12-23 10:57:48 | 显示全部楼层 |阅读模式
1明经币
图纸钢筋符号显示是:一级钢是%%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

查看完整内容

楼主是不是这个意思？
照片, 勇气, repeat
"觉得好，就打赏"
打赏
还没有人打赏，支持一下

相关帖子
回复

使用道具 举报

highflybird
发表于 2011-12-23 10:57:49 | 显示全部楼层
本帖最后由 highflybird 于 2011-12-23 17:11 编辑

楼主是不是这个意思？


  3. (vl-load-com)
  4. (defun c:test (/ ss n ent obj txt)
  5.   (if (setq ss (ssget '((0 . "*TEXT") (1 . "*%%128*,*%%129*,*%%130*,*%%131*,*%%133*"))))
  6.     (repeat (setq n (sslength ss))
  7.       (setq ent (ssname ss (setq n (1- n))))
  8.       (setq obj (vlax-ename->vla-object ent))
  9.       (setq txt (vla-get-textstring obj))
  10.       (cond
  11. ((wcmatch txt "*%%128*")
  12.   (setq txt (ReplaceText "%%129" "%%128" txt))
  13. )
  14. ((wcmatch txt "*%%129*")
  15.   (setq txt (ReplaceText "%%130" "%%129" txt))
  16. )
  17. ((wcmatch txt "*%%130*")
  18.   (setq txt (ReplaceText "%%131" "%%130" txt))
  19. )
  20. ((wcmatch txt "*%%131*")
  21.   (setq txt (ReplaceText "%%132" "%%131" txt))
  22. )
  23. ((wcmatch txt "*%%133*")
  24.   (setq txt (ReplaceText "%%132" "%%133" txt))
  25. )
  26.       )
  27.       (vla-put-textstring obj txt)
  28.     )
  29.   )
  30.   (princ)
  31. )
  32. (defun ReplaceText (NewStr oldstr string / txt)
  33.   (setq txt string)
  34.   (while (vl-string-search oldstr txt)
  35.     (setq txt (VL-STRING-SUBST NewStr oldstr txt))
  36.   )
  37.   txt
  38. )

点评

尘缘一生
这段代码是全图修改，实际使用不是，是局部选择修改，如何改下？我把你的 "x" ...去掉，根本不好用。  发表于 2019-4-23 11:14

评分

参与人数 1明经币 +1 收起 理由
flytoday + 1 很给力!钢筋等级符号实际与字体对应了,很好.

查看全部评分

回复

使用道具 举报

flytoday
 楼主| 发表于 2011-12-23 14:40:18 | 显示全部楼层
哪位大侠路过滴给改改谢谢
回复

使用道具 举报

【KAIXIN】
发表于 2011-12-23 15:12:34 | 显示全部楼层
如果只是以上三个就好办，批量的麻烦
回复

使用道具 举报

夏生生
发表于 2011-12-23 16:07:48 | 显示全部楼层
  2. (defun c:gjth()
  3. (reptext "%%133" "%%132")
  4. (reptext "%%130" "%%131")
  5. (reptext "%%129" "%%130")
  6. ;下面用于老版TSSD2010
  7. (reptext "\134U+233" "%%13")
  8. ;下面用于最新版TSSD2010
  9. (reptext "" "%%130")
  10. (reptext "" "%%131")
  11. (reptext "" "%%132")
  12. (reptext "" "%%133"))
  13. ;;; (reptext <要找的文字> <替换成的文字>)

  15. (defun reptext (oldch newch / ss ssl ct0 edata etext txtln subln ct1 ct2 schct newtext)

  17. (setq ss (ssget "x" '((0 . "*TEXT")))) ;选择文字
  18.   (if ss
  19.     (progn
  20.       (setq ssl (sslength ss)
  21.             ct0 0
  22.             ct1 0
  23.             ct2 0
  24.             subln (strlen oldch)
  25.       )
  26.       (while (< ct0 ssl)
  27.         (setq edata (entget (ssname ss ct0))
  28.               etext (cdr (assoc 1 edata))
  29.               txtln (strlen etext)
  30.               schct 1
  31.               newtext ""
  32.         )
  33.         (while (<= schct txtln)
  34.           (setq newtext
  35.             (strcat newtext
  36.               (if (= (setq readch (substr etext schct subln)) oldch)
  37.                 (setq ct1 (1+ ct1)
  38.                   schct (+ schct subln)
  39.                   newch newch
  40.                 )
  41.                 (progn
  42.                   (setq schct (1+ schct))
  43.                   (substr readch 1 1)
  44.                 )
  45.               )
  46.             )
  47.           )
  48.         )
  49.         (if (/= etext newtext)
  50.    (progn
  51.             (entmod (subst (cons 1 newtext) (assoc 1 edata) edata))
  52.             (setq ct2 (1+ ct2))
  53.           )
  54.         )
  55.         (setq ct0 (1+ ct0))
  56.       )
  57.     )
  58.   )
  59. )

点评

尘缘一生
这段代码是全图修改，实际使用不是，是局部选择修改，如何改下？我把你的 "x" ...去掉，根本不好用。 发表  发表于 2019-4-23 11:14
尘缘一生
这个替换探索者钢筋符号很方便。  发表于 2019-4-20 16:42
【KAIXIN】
不错！函数弄的好  发表于 2011-12-23 16:24
回复

使用道具 举报

x_s_s_1
发表于 2011-12-23 16:09:27 | 显示全部楼层
上面的代码用于老版的TSSD2010和最新板TSSD2010测试通过，由于没有您的字体，没有测试前面的，注意不要改变代码位置
回复

使用道具 举报

cnks
发表于 2011-12-24 02:45:48 | 显示全部楼层
抬高物价，是通货膨胀么
回复

使用道具 举报

尘缘一生
发表于 2019-4-23 11:30:43 | 显示全部楼层
本帖最后由 尘缘一生 于 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")
)
;;说明:选取方式批量替换钢筋--结束
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-16 02:22 , Processed in 0.194412 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表