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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [讨论]：有关文本编辑问题
返回列表 发新帖
查看: 674|回复: 7

[讨论]：有关文本编辑问题

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

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

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

×
本主题探讨有关文本的编辑问题，请大家献计献策。
先出手“文本匹配”程序。
  2. [FONT=courier new](load "xyp_lib")
  3. ;|加载通用函数(可在签名栏直接下载)
  4. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
  5. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
  6. ★1·在acad.lsp中增加(load"xyp_lib")
  7. ■2·在每个程序内增加(load"xyp_lib")
  8. ■3·在command下，输入(load"xyp_lib")
  9. ■4·在菜单.mnl中增加(load"xyp_lib")
  10. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
  11. [COLOR=red] ★通用函数下载地址：[/COLOR]
  12. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
  13. [url]http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&ID=37554&page=1[/url]|;

  15. ;;;文本匹配
  16. (defun c:wbpp ()
  17.   (CMDLA0)
  18.   (setq tx (UKWORD 7 "1 2 3 4 5 6" "\n匹配选项 : 1-字符/2-字型/3-字高/4-字宽/5-旋转角/6-倾斜角"         tx))
  19.   (cond        ((= tx "1") (TEXT-PP 1))
  20.         ((= tx "2") (TEXT-PP 7))
  21.         ((= tx "3") (TEXT-PP 40))
  22.         ((= tx "4") (TEXT-PP 41))
  23.         ((= tx "5") (TEXT-PP 50))
  24.         ((= tx "6") (TEXT-PP 51))
  25.   )
  26.   (CMDLA1)
  27. )
  28. (defun TEXT-PP (#mode / ent new i ss s1)
  29.   (princ "\n选择样板 : ")
  30.   (setq        ent (usel 0 "TEXT")
  31.         new (dxf #mode (entget (car ent)))
  32.         i   -1
  33.   )
  34.   (princ "\n选择要匹配的文本 : ")
  35.   (setq SS (ssget '((0 . "TEXT"))))
  36.   (while (setq s1 (ssname ss (setq i (1+ i))))
  37.     (sub_upd s1 #mode new)
  38.   )
  39. )[/FONT]
TEXT, 文本, 匹配

相关帖子

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

使用道具 举报

狂刀
发表于 2005-10-14 00:38:10 | 显示全部楼层
多个选项最好可多选（用对话框最好）
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
 楼主| 发表于 2005-10-14 08:00:59 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
改换字型：将所选文本的字型改为当前所设字型
  2. [FONT=courier new]
  3. ;;;* 改换字型
  4. (DEFUN C:GHZX (/ SS s1 n tx)
  5.   (cmdla0)
  6.   (prompt "\n将所选文本的字型改为当前所设字型。")
  7.   (princ "\n选择文本 : ")
  8.   (while (not (SETQ SS (ssget '((0 . "*TEXT"))))))
  9.   (setq        s1 (ssname SS 0)
  10.         n  -1
  11.         tx (getvar "textstyle")
  12.   )
  13.   (princ "\n旧字型为 : ")
  14.   (princ (dxf 7 (entget S1)))
  15.   (princ "新字型为 ")
  16.   (princ tx)
  17.   (princ "\n稍候 : ")
  18.   (while (setq s1 (ssname SS (setq n (1+ n))))
  19.     (sub_upd s1 7 TX)
  20.     (princ ".")
  21.   )
  22.   (princ n)
  23.   (princ "个改变字型!")
  24.   (cmdla1)
  25. )
  26. [/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
 楼主| 发表于 2005-10-14 13:01:16 | 显示全部楼层
改换字高：将原有文本的字高改为新字高。
[php];;;* 改换字高
(DEFUN C:GHZG (/ SS n s1)
  (cmdla0)
  (prompt "\n将原有文本的字高改为新字高。\n选择文本 : ")
  (while (not (SETQ SS (ssget '((0 . "*TEXT"))))))
  (princ "\n旧字高为 ")
  (princ (dxf 40 (entget (ssname SS 0))))
  (setq        th (ureal 7 "" "\n新字高为" th)
        n  -1
  )
  (princ "\n稍候 : ")
  (while (setq s1 (ssname SS (setq n (1+ n))))
    (sub_upd s1 40 TH)
    (princ ".")
  )
  (princ n)
  (princ "个改变字高!")
  (cmdla1)
)
[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
 楼主| 发表于 2005-10-14 13:04:25 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
改换字宽：将原有文本的字宽改为新字宽。
[php];;;* 改换字宽
(DEFUN C:GHZK (/ SS n s1)
  (cmdla0)
  (prompt "\n将原有文本的字宽改为新字宽。\n选择文本 : ")
  (while (not (SETQ SS (ssget '((0 . "*TEXT"))))))
  (princ "\n旧字宽为 ")
  (princ (dxf 41 (entget (ssname SS 0))))
  (setq        th (ureal 7 "" "\n新字宽为" th)
        n  -1
  )
  (princ "\n稍候 : ")
  (while (setq s1 (ssname SS (setq n (1+ n))))
    (sub_upd s1 41 TH)
    (princ ".")
  )
  (princ n)
  (princ "个改变字宽!")
  (cmdla1)
)[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

eachy

已领礼包: 593个

财富等级: 财运亨通
发表于 2005-10-14 13:10:51 | 显示全部楼层
改字高用CAD的 scaletext 命令最快了（AutoCAD 2000+，不知道含不含CAD2000），关于多选项提示部分建议符合 2006 那种弹出选项。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
 楼主| 发表于 2006-2-15 23:08:16 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
改字母大小写
  2. [FONT=courier new];;;改字母大小写
  3. (defun c:test003 ()
  4.   (CMDLA0)
  5.   (setq dx (UKWORD 1 "1 2" "\n修改方式: 1-大写/2-小写" dx))
  6.   (prompt "\n请选择要改变的字符串 : ")
  7.   (setq        ss (ssget '((0 . "TEXT")))
  8.         i  -1
  9.   )
  10.   (while (setq s1 (ssname ss (setq i (1+ i))))
  11.     (setq tx (xyp-get-DXF 1 s1))
  12.     (if        (= dx "1")
  13.       (setq tx (strcase tx))
  14.       (setq tx (strcase tx T))
  15.     )
  16.     (sub_upd s1 1 tx)
  17.   )
  18.   (CMDLA1)
  19. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
 楼主| 发表于 2006-2-15 23:09:18 | 显示全部楼层
批量炸碎文字变成线
  2. [FONT=courier new];;;批量炸碎文字变成线
  3. (Defun c:test004 ()
  4.   (CMDLA0)
  5.   (SetVar "MIRRTEXT" 1)
  6.   (setvar "osmode" 0)
  7.   (PrinC "\n选择要分解的文字 : ")
  8.   (setq        ss (ssget '((0 . "TEXT")))
  9.         i  -1
  10.   )
  11.   (while (setq s1 (ssname ss (setq i (1+ i))))
  12.     (setq pt1 (xyp-get-MinMaxPoint s1 1)
  13.           pt2 (xyp-get-MinMaxPoint s1 9)
  14.           pt  (xyp-get-MidPoint pt1 pt2)
  15.           pt3 (polar pt (* pi 0.5) 100)
  16.     )
  17.     (Command "mirror" s1 "" pt pt3 "y")
  18.     (command "zoom" "w" pt1 pt2)
  19.     (command "wmfout" "TEXTWMF" s1 "" "erase" s1 "")
  20.     (command "wmfin" "TEXTWMF" pt "2" "" "")
  21.     (setq s1 (EntLast))
  22.     (command "mirror" s1 "" pt pt3 "y")
  23.     (setq pt0 (xyp-get-MidPoint
  24.                 (xyp-get-MinMaxPoint s1 1)
  25.                 (xyp-get-MinMaxPoint s1 9)
  26.               )
  27.     )
  28.     (command "move" s1 "" pt0 pt)
  29.     (command "explode" s1 "")
  30.   )
  31.   (setvar "MIRRTEXT" 0)
  32.   (CMDLA1)
  33. )
  34. [/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-9-29 02:33 , Processed in 0.377461 second(s), 46 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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