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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › 晓东工具箱、编程申请 › [LISP函数]：XYP,,EACHY,斑竹进来修改
返回列表 发新帖
查看: 1534|回复: 5

[LISP函数]：XYP,,EACHY,斑竹进来修改

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

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

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

×
;;本程序用目标文字替换需改变的文字。可以是TEXT和属性块中的属性
(defun c:12(/ a b ent ent2 elist etype oldval bltxt entdata btxt ostr pt oltxt )
(princ "\n 请选择复制源文字目标:")
(setq ent (nentsel))
(if (= ent nil) (setq oldval (getstring "\n 请输入文字:"))
(progn
(setq
ent2 ent
elist (entget (car ent))
etype (cdr (assoc 0 elist))
)
(setq oldval (cdr (assoc 1 elist)))  
(princ "\n复制文字内容为: ") (princ oldval)
))
(setq q 9)
(while q  
(setq bltxt (nentsel "\n请选择需要替换的文字目标:"))
(if (= bltxt nil)(setq q nil)
(progn
(setq entdata (entget (car bltxt)) btxt (cdr (assoc 1 entdata)) ostr btxt)
(setq elist (entget (car bltxt)))
(setq etype (cdr (assoc 0 elist)))
;(setq oltxt (car (assoc 1 elist)))
(setq oltxt (cdr (assoc 1 elist)))
(if (= etype "ATTRIB")
(progn
(setq pt (cadr bltxt))
(command ".attedit" "" "" "" "" pt "" "V" "R" oldval "n")
)
(progn
(setq btxt oldval)
(entmod (subst (cons 1 btxt)(assoc 1 entdata) entdata))
(if (setq bltxt (car (reverse (cadddr bltxt)))) (entupd bltxt))
))))
(princ "\n原文字为:")(princ oltxt)(princ ". 已被替换为: ")(princ oldval)(princ " .")
)
(princ)
setq, bltxt, princ

相关帖子

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

使用道具 举报

xyp1964
发表于 2005-11-9 16:50:25 | 显示全部楼层

Re: [LISP函数]：XYP,,EACHY,斑竹进来修改

最初由 MJJ3468 发布
[B];;本程序用目标文字替换需改变的文字。可以是TEXT和属性块中的属性
(defun c:12(/ a b ent ent2 elist etype oldval bltxt entdata btxt ostr pt oltxt )
(princ "\n 请选择复制源文字目标:")
(setq ent (nents... [/B]

不会修改，这个不知怎样？
  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. ;;;用目标文字替换需改变的文字（可以是TEXT和属性块中的某个属性值）
  17. (defun c:test ()
  18.   (cmdla0)
  19.   (setq        s-t (xyp-get-DXF 1 (car (usel1 0 "TEXT" "TEXT源文字")))
  20.         ss  (ssget '((0 . "INSERT,TEXT")))
  21.         i   -1
  22.   )
  23.   (while (setq s1 (ssname ss (setq i (1+ i))))
  24.     (setq etype (xyp-get-DXF 0 s1))
  25.     (cond ((= etype "TEXT") (sub_upd s1 1 s-t))
  26.           ((= etype "INSERT")
  27.            (if (xyp-get-Attibutes s1)
  28.              (progn
  29.                (setq
  30.                  lst (vlax-safearray->list
  31.                        (vlax-variant-value
  32.                          (vla-GetAttributes (vlax-ename->vla-object s1))
  33.                        )
  34.                      )
  35.                )
  36.                (if (setq at (nth 0 lst)) ;属性值序列
  37.                  (vla-put-TextString at s-t)
  38.                )
  39.              )
  40.            )
  41.           )
  42.     )
  43.   )
  44.   (cmdla1)
  45. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

MJJ3468
 楼主| 发表于 2005-11-9 18:33:35 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

Re: Re: [LISP函数]：XYP,,EACHY,斑竹进来修改

最初由 xyp1964 发布
[B][QUOTE]最初由 MJJ3468 发布
[B];;本程序用目标文字替换需改变的文字。可以是TEXT和属性块中的属性
(defun c:12(/ a b ent ent2 elist etype oldval bltxt entdata btxt ostr pt oltxt )
(princ "\n 请选... [/B]


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

使用道具 举报

eachy

已领礼包: 593个

财富等级: 财运亨通
发表于 2005-11-9 18:56:30 | 显示全部楼层
指哪换哪

  3. ;;本程序用目标文字替换需改变的文字。可以是TEXT和属性块中的属性
  4. (defun c:12 (/ ent el str e)
  5.   (princ "\n选择源文字:")
  6.   (if (and (setq ent (car (nentsel)))
  7.            (setq el (entget ent))
  8.            (wcmatch (cdr (assoc 0 el)) "*TEXT,ATTR*")
  9.       )
  10.     (setq str (cdr (assoc 1 el)))
  11.     (setq str (getstring "\n 请输入文字:"))
  12.   )
  13.   (if (/= str "")
  14.     (while (and        (setq e (nentsel "\n请选择替换的文字目标:"))
  15.                 (setq el (entget(car  e)))
  16.                 (wcmatch (cdr (assoc 0 el)) "*TEXT,ATTR*")
  17.            )
  18.       (entmod (subst (cons 1 str) (assoc 1 el) el))
  19.       (if (= (cdr (assoc 0 el)) "ATTRIB")
  20.         (entupd (cdr (assoc 330 el))))
  21.     )
  22.   )
  23.   (princ)
  24. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

MJJ3468
 楼主| 发表于 2005-11-10 09:12:25 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最初由 eachy 发布
[B]指哪换哪
[code]
;;本程序用目标文字替换需改变的文字。可以是TEXT和属性块中的属性
(defun c:12 (/ ent el str e)
  (princ "\n选择源文字:")
  (if (and (setq ent (car (nentsel)))
           (setq el (entget e... [/B]

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

使用道具 举报

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-9-21 21:52 , Processed in 0.191444 second(s), 42 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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