设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [求助]：高手来改：文字格式刷
返回列表 发新帖
查看: 626|回复: 3

[求助] [求助]：高手来改：文字格式刷

[复制链接]
pipi002004
发表于 2005-10-31 14:48:05 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
我以前收集的一个lisp，文字刷功能比较好用，可是这个刷子只能刷一次就不能用了，要退出r14后重新来过又只能用1次，我晕死，作者可能想要我门经常想起他，搞了这么个套套！！
希望会改的兄弟改一下
附原代码
(DEFUN C:WT (/ KEY ENT1 EL EN N SS TH VAL)
  (SETVAR "cmdecho" 0)
  (SETVAR "blipmode" 0)
  (IF (= KEY1 NIL)
    (PROGN
      (INITGET 1 "N G Q T Y X C")
      (SETQ KEY (GETKWORD "\n/内容-N/高度-G/图层-C/样式-Y/倾斜角-Q/旋转角-X: "))
      (COND
        ((= KEY "N")
          (SETQ VAL 1)
        )
        ((= KEY "G")
          (SETQ VAL 40)
        )
        ((= KEY "C")
          (SETQ VAL 8)
        )
        ((= KEY "Y")
          (SETQ VAL 7)
        )
        ((= KEY "Q")
          (SETQ VAL 51)
        )
        ((= KEY "X")
          (SETQ VAL 50)
        )
        (T
          NIL
        )
      )
      (SETQ KEY1 KEY)
    )
    (PROGN
      (INITGET "N G Q T Y X C")
      (SETQ KEY (GETKWORD "\n/内容-N/高度-G/图层-C/样式-Y/倾斜角-Q/旋转角-X : "
                          N ""
                )
      )
      (IF (= KEY NIL)
        (PROGN
          (SETQ KEY KEY1)
          (COND
            ((= KEY "N")
              (SETQ VAL 1)
            )
            ((= KEY "G")
              (SETQ VAL 40)
            )
            ((= KEY "C")
              (SETQ VAL 8)
            )
            ((= KEY "Y")
              (SETQ VAL 7)
            )
            ((= KEY "Q")
              (SETQ VAL 51)
            )
            ((= KEY "X")
              (SETQ VAL 50)
            )
            (T
              NIL
            )
          )
        )
        (PROGN
          (SETQ KEY1 KEY)
          (COND
            ((= KEY "N")
              (SETQ VAL 1)
            )
            ((= KEY "G")
              (SETQ VAL 40)
            )
            ((= KEY "C")
              (SETQ VAL 8)
            )
            ((= KEY "Y")
              (SETQ VAL 7)
            )
            ((= KEY "Q")
              (SETQ VAL 51)
            )
            ((= KEY "X")
              (SETQ VAL 50)
            )
            (T
              NIL
            )
          )
        )
      )
    )
  )
  (IF (SETQ ENT1 (CAR (ENTSEL "\n先点选源文本:")))
    (PROGN
      (SETQ EN (ENTGET ENT1))
      (= "TEXT" (CDR (ASSOC 0 EN)))
      (SETQ TH (CDR (ASSOC VAL EN)))
      (PRINC "\n再选择目标文本：")
      (IF (SETQ SS (SSGET '((0 . "TEXT"))))
        (PROGN
          (SETQ N 0)
          (WHILE (< N (SSLENGTH SS))
            (SETQ EL (ENTGET (SSNAME SS N)))
            (ENTMOD (SUBST
                      (CONS (CAR (ASSOC VAL EL)) TH)
                      (ASSOC VAL EL)
                      EL
                    )
            )
            (SETQ N (1+ N))
          )
        )
      )
    )
  )
  (SETVAR "blipmode" OLDBLP)
  (SETVAR "cmdecho" OLDECH)
  (PRINC)
)
对xyp热情表示深深的敬意！
SETQ, KEY, VAL

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

mmmm
发表于 2005-10-31 15:52:19 | 显示全部楼层

  3. (DEFUN C:WT (/ OLDBLP OLDECH KEY ENT1 EL EN N SS TH VAL)
  4.   (setq        OLDBLP (gETVAR "blipmode")
  5.         OLDECH (gETVAR "cmdecho")
  6.   )
  7.   (SETVAR "cmdecho" 0)
  8.   (SETVAR "blipmode" 0)
  9.   (IF (= KEY1 NIL)
  10.     (PROGN
  11.       (INITGET 1 "N G Q T Y X C")
  12.       (SETQ KEY        (GETKWORD
  13.                   "\n/内容-N/高度-G/图层-C/样式-Y/倾斜角-Q/旋转角-X: "
  14.                 )
  15.       )
  16.       (COND
  17.         ((= KEY "N")
  18.          (SETQ VAL 1)
  19.         )
  20.         ((= KEY "G")
  21.          (SETQ VAL 40)
  22.         )
  23.         ((= KEY "C")
  24.          (SETQ VAL 8)
  25.         )
  26.         ((= KEY "Y")
  27.          (SETQ VAL 7)
  28.         )
  29.         ((= KEY "Q")
  30.          (SETQ VAL 51)
  31.         )
  32.         ((= KEY "X")
  33.          (SETQ VAL 50)
  34.         )
  35.         (T
  36.          NIL
  37.         )
  38.       )
  39.       (SETQ KEY1 KEY)
  40.     )
  41.     (PROGN
  42.       (INITGET "N G Q T Y X C")
  43.       (SETQ
  44.         KEY (GETKWORD
  45.               "\n/内容-N/高度-G/图层-C/样式-Y/倾斜角-Q/旋转角-X : "             
  46.             )
  47.       )
  48.       (IF (= KEY NIL)
  49.         (PROGN
  50.           (SETQ KEY KEY1)
  51.           (COND
  52.             ((= KEY "N")
  53.              (SETQ VAL 1)
  54.             )
  55.             ((= KEY "G")
  56.              (SETQ VAL 40)
  57.             )
  58.             ((= KEY "C")
  59.              (SETQ VAL 8)
  60.             )
  61.             ((= KEY "Y")
  62.              (SETQ VAL 7)
  63.             )
  64.             ((= KEY "Q")
  65.              (SETQ VAL 51)
  66.             )
  67.             ((= KEY "X")
  68.              (SETQ VAL 50)
  69.             )
  70.             (T
  71.              NIL
  72.             )
  73.           )
  74.         )
  75.         (PROGN
  76.           (SETQ KEY1 KEY)
  77.           (COND
  78.             ((= KEY "N")
  79.              (SETQ VAL 1)
  80.             )
  81.             ((= KEY "G")
  82.              (SETQ VAL 40)
  83.             )
  84.             ((= KEY "C")
  85.              (SETQ VAL 8)
  86.             )
  87.             ((= KEY "Y")
  88.              (SETQ VAL 7)
  89.             )
  90.             ((= KEY "Q")
  91.              (SETQ VAL 51)
  92.             )
  93.             ((= KEY "X")
  94.              (SETQ VAL 50)
  95.             )
  96.             (T
  97.              NIL
  98.             )
  99.           )
  100.         )
  101.       )
  102.     )
  103.   )
  104.   (IF (SETQ ENT1 (CAR (ENTSEL "\n先点选源文本:")))
  105.     (PROGN
  106.       (SETQ EN (ENTGET ENT1))
  107.       (= "TEXT" (CDR (ASSOC 0 EN)))
  108.       (SETQ TH (CDR (ASSOC VAL EN)))
  109.       (PRINC "\n再选择目标文本：")
  110.       (IF (SETQ SS (SSGET '((0 . "TEXT"))))
  111.         (PROGN
  112.           (SETQ N 0)
  113.           (WHILE (< N (SSLENGTH SS))
  114.             (SETQ EL (ENTGET (SSNAME SS N)))
  115.             (ENTMOD (SUBST
  116.                       (CONS (CAR (ASSOC VAL EL)) TH)
  117.                       (ASSOC VAL EL)
  118.                       EL
  119.                     )
  120.             )
  121.             (SETQ N (1+ N))
  122.           )
  123.         )
  124.       )
  125.     )
  126.   )  
  127.   (PRINC)
  128. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

pipi002004
 楼主| 发表于 2005-10-31 18:00:34 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
经过测试,在r14, xp sp2下,程序完美,没发现错误及不良现象,建议斑竹对此好心人加分表扬.
在这里我对您的热心帮助表示我最衷心的感谢!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2005-10-31 20:23:54 | 显示全部楼层
2004版的“文本匹配”：
  2. [FONT=courier new]
  3. (load "xyp_lib")
  4. ;|加载通用函数(可在签名栏直接下载)
  5. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
  6. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
  7. ★1·在acad.lsp中增加(load"xyp_lib")
  8. ■2·在每个程序内增加(load"xyp_lib")
  9. ■3·在command下，输入(load"xyp_lib")
  10. ■4·在菜单.mnl中增加(load"xyp_lib")
  11. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
  12. [COLOR=red] ★通用函数下载地址：[/COLOR]
  13. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
  14. |;

  16. ;;;文本匹配
  17. (defun c:wbpp ()
  18.   (CMDLA0)
  19.   (setq tx (UKWORD 7 "1 2 3 4 5 6 7"
  20.          "\n匹配选项 : 1-字符/2-字型/3-字高/4-字宽/5-旋转角/6-倾斜角/7-图层" tx)
  21.   )
  22.   (cond        ((= tx "1") (TEXT-PP 1))
  23.         ((= tx "2") (TEXT-PP 7))
  24.         ((= tx "3") (TEXT-PP 40))
  25.         ((= tx "4") (TEXT-PP 41))
  26.         ((= tx "5") (TEXT-PP 50))
  27.         ((= tx "6") (TEXT-PP 51))
  28.         ((= tx "7") (TEXT-PP 8))
  29.   )
  30.   (CMDLA1)
  31. )
  32. (defun TEXT-PP (mode / ent new i ss s1)
  33.   (princ "\n选择样板文本 : ")
  34.   (setq        ent (USEL1 0 "TEXT" "TEXT文本")
  35.         new (cdr (assoc mode (entget (car ent))))
  36.         i   -1
  37.   )
  38.   (princ "\n选择要匹配的文本 : ")
  39.   (setq SS (ssget '((0 . "TEXT"))))
  40.   (while (setq s1 (ssname ss (setq i (1+ i))))
  41.     (sub_upd s1 mode new)
  42.   )
  43. )
  44. [/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-9-28 18:36 , Processed in 0.213081 second(s), 38 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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