找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 4229|回复: 34

[已解决] 将含有相同内容文本图元的组或块变为同一块参照

[复制链接]
发表于 2014-4-1 08:19:48 | 显示全部楼层 |阅读模式
悬赏200D豆已解决
本帖最后由 newer 于 2021-2-4 05:24 编辑

我的图上有很多文字是组。缺点是含有相同内容文本图元的组或块却不同名。如果是同名的块,那我只要改一个块,其它的块就会改好了。所以求高手帮我写一个代码,将含有相同内容的TEXT的块或组变成一个同名块参照。
块名的使用规则为:将新块内的多个文本内容排序,再组合成一个新内容,组合公式为“0111”+“镡”+排序后第1个文本内容+“镡”+排序后第2个文本内容+“镡”+排序后第3个文本内容+“镡”+排序后第4个文本内容,以此类推。
示例如下:将含“Q”、“al+pl”、“4”三个文本的块命名为“0111镡4镡al+pl镡Q”,因为在字符串对比中“4”<“al+pl”<Q。
将组变为块时,以组中所有图元的外轮廓线的中心点作为块的插件点。
用已有块替换组时,也是将块插入在组中所有图元的外轮廓线的中心点。
至于含有相同内容的TEXT的块或组是否有其它图元会不同时,这点不用考虑。我设定它是,只要文本内容相同,则它们中的图元肯定是相同的。
请点击此处下载

查看状态:需购买或无权限

您的用户组是:游客

文件名称:相同内容的组做成一个统一的块参照.rar 
下载次数:9  文件大小:205.9 KB 
下载权限: 不限 以上  [免费赚D豆]


再求一个,是由上面代码派生的,即将选定的块、组、线、文本制作成一个块参照(原有的块和组炸开),新块的命名原则也是同上面一样的: 将新块内的多个文本内容排序,再组合成一个新内容,组合公式为“0111”+“镡”+排序后第1个文本内容+“镡”+排序后第2个文本内容+“镡”+排序后第3个文本内容+“镡”+排序后第4个文本内容,以此类推。

最佳答案

查看完整内容

自己改啊! 改个过滤器还不会! 组已变,留组已无用,加两句删除
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2014-4-1 08:19:49 | 显示全部楼层
清风明月10 发表于 2014-4-1 10:02
(8 . "GiCAD_SDYX")
而且,老师,你总是将它限定在上面图层中。我的目标是所有图层的块或组,只要所有文 ...

自己改啊! 改个过滤器还不会!
组已变,留组已无用,加两句删除
  1. (defun c:tt (/ _center ms ss lst gn)
  2.   (defun _center (el)
  3.     (apply 'xdrx_points_centroid
  4.            (apply 'append (mapcar 'xdrx_entity_box el))
  5.     )
  6.   )
  7.   (if (setq ss (ssget '((0 . "text") (8 . "GiCAD_SDYX"))))
  8.     (progn
  9.       (setq lst        (mapcar
  10.                   '(lambda (x)
  11.                      (list (car (test (get_object_reactor x)))
  12.                            (list (xdrx_getpropertyvalue x "Textstring") x)
  13.                      )
  14.                    )
  15.                   (xdrx_pickset->ents ss)
  16.                 )
  17.             lst        (XD::List:GroupByIndex lst 0)
  18.             gn (mapcar 'car lst)
  19.             lst        (XD::List:GroupByIndex
  20.                   (mapcar '(lambda (x)
  21.                              (list (mapcar 'car x)
  22.                                    (mapcar 'cadr x)
  23.                              )
  24.                            )
  25.                           (mapcar 'cdr lst)
  26.                   )
  27.                   0
  28.                 )
  29.             lst        (mapcar        '(lambda (x)
  30.                            (cons (strcat "0011镡"
  31.                                          (xdrx_string_join
  32.                                            (acad_strlsort (car x))
  33.                                            "镡"
  34.                                          )
  35.                                  )
  36.                                  (cdr x)
  37.                            )
  38.                          )
  39.                         lst
  40.                 )
  41.             ms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
  42.       )
  43.       (mapcar '(lambda (x)
  44.                  (xdrx_block_make
  45.                    (car x)
  46.                    (XD::Entity->Pickset (cadr x))
  47.                    (_center (cadr x))                  
  48.                    t
  49.                  )
  50.                  (mapcar '(lambda (a)
  51.                             (vla-insertblock
  52.                               ms
  53.                               (vlax-3d-point (_center a))
  54.                               (car x)
  55.                               1.
  56.                               1.
  57.                               1.
  58.                               0.
  59.                             )
  60.                           )
  61.                          (cddr x)
  62.                  )
  63.                )
  64.               lst
  65.       )
  66.       (xdrx_entity_delete ss)
  67.       (mapcar 'xdrx_group_del gn)
  68.     )
  69.   )
  70.   (princ)
  71. )

点评

完善后,发布到每日插件吧。  详情 回复 发表于 2014-4-1 10:33
我试了,运行效果很好!谢谢您!就是还有另外一个部分,即“将含有相同内容的TEXT的块变成一个同名块参照”这个部分没有啊?帮我加入这个部分吧。代码加入原插件也可以,写成独立插件也可以  发表于 2014-4-1 10:28
老师,含相同文本文件的块参照还没有改为同一名称的块参照啊?  发表于 2014-4-1 10:13

评分

参与人数 1D豆 +10 收起 理由
清风明月10 + 10 热心帮忙奖!

查看全部评分

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

使用道具 举报

发表于 2014-4-1 08:34:08 | 显示全部楼层
你用 VBA  写一个
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

 楼主| 发表于 2014-4-1 08:42:25 | 显示全部楼层
我的水平无法解决这么复杂的难题。VBA更难写

点评

美女,你试着写个,LISP. 思路什么,难点在哪,大家一起帮你完善,只要鱼吃不了很久的.  详情 回复 发表于 2014-4-1 09:41
先写一部分分组的,后面就是做块、插入、删除了 用到一个找实体所属组程序 http://bbs.xdcad.net/forum.php?mod=viewthread&tid=127718  详情 回复 发表于 2014-4-1 09:41
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

发表于 2014-4-1 09:41:02 | 显示全部楼层
本帖最后由 Free-Lancer 于 2014-4-1 09:49 编辑
清风明月10 发表于 2014-4-1 08:42
我的水平无法解决这么复杂的难题。VBA更难写

先写一部分分组的,后面就是做块、插入、删除了
用到一个找实体所属组程序
http://bbs.xdcad.net/forum.php?mod=viewthread&tid=127718
  1. (defun c:tt (/ _center ss lst)
  2.   (defun _center (el)
  3.     (apply 'xdrx_points_centroid
  4.            (apply 'append (mapcar 'xdrx_entity_box el))
  5.     )
  6.   )
  7.   (if (setq ss (ssget '((0 . "text") (8 . "GiCAD_SDYX"))))
  8.     (progn
  9.       (setq lst        (mapcar
  10.                   '(lambda (x)
  11.                      (list (car (test (get_object_reactor x)))
  12.                            (list (xdrx_getpropertyvalue x "Textstring") x)
  13.                      )
  14.                    )
  15.                   (xdrx_pickset->ents ss)
  16.                 )
  17.             lst        (XD::List:GroupByIndex lst 0);_用组名分
  18.             lst        (XD::List:GroupByIndex
  19.                   (mapcar '(lambda (x)
  20.                              (list (mapcar 'car x)
  21.                                    (mapcar 'cadr x)
  22.                              )
  23.                            )
  24.                           (mapcar 'cdr lst)
  25.                   )
  26.                   0
  27.                 );_组内文字是否相同分组
  28.             lst        (mapcar        '(lambda (x)
  29.                            (cons (strcat "0011镡"
  30.                                          (xdrx_string_join
  31.                                            (acad_strlsort (car x))
  32.                                            "镡"
  33.                                          )
  34.                                  )
  35.                                  (cdr x)
  36.                            )
  37.                          )
  38.                         lst
  39.                 )
  40.       )
  41.     )
  42.   )
  43. )

点评

; 错误: no function definition:“TEST 没有这个“TEST”自定义函数啊!”  详情 回复 发表于 2014-4-1 09:58
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2014-4-1 09:41:12 | 显示全部楼层
清风明月10 发表于 2014-4-1 08:42
我的水平无法解决这么复杂的难题。VBA更难写

美女,你试着写个,LISP.

思路什么,难点在哪,大家一起帮你完善,只要鱼吃不了很久的.

点评

如果我有充裕时间,我肯定会边写边问,太忙了,不敢去细研究。老板老说要开除我,因为我搞代码  详情 回复 发表于 2014-4-1 09:47
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

 楼主| 发表于 2014-4-1 09:47:46 | 显示全部楼层
newer 发表于 2014-4-1 09:41
美女,你试着写个,LISP.

思路什么,难点在哪,大家一起帮你完善,只要鱼吃不了很久的.

如果我有充裕时间,我肯定会边写边问,太忙了,不敢去细研究。老板老说要开除我,因为我搞代码

点评

不需要花太多时间,完整代码如下 api 的Insert_make 不稳定,用 vla 方法  详情 回复 发表于 2014-4-1 09:58
你没让老板看看你的威力?  详情 回复 发表于 2014-4-1 09:57
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

已领礼包: 13个

财富等级: 恭喜发财

发表于 2014-4-1 09:57:51 | 显示全部楼层
清风明月10 发表于 2014-4-1 09:47
如果我有充裕时间,我肯定会边写边问,太忙了,不敢去细研究。老板老说要开除我,因为我搞代码

你没让老板看看你的威力?

点评

好象我国的绝大多数老板都不喜好培养人才,只要现实  发表于 2014-4-1 10:18
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

发表于 2014-4-1 09:58:40 | 显示全部楼层
清风明月10 发表于 2014-4-1 09:47
如果我有充裕时间,我肯定会边写边问,太忙了,不敢去细研究。老板老说要开除我,因为我搞代码

不需要花太多时间,完整代码如下
api 的Insert_make 不稳定,用 vla 方法
  1. (defun c:tt (/ _center ms ss lst)
  2.   (defun _center (el)
  3.     (apply 'xdrx_points_centroid
  4.            (apply 'append (mapcar 'xdrx_entity_box el))
  5.     )
  6.   )
  7.   (if (setq ss (ssget '((0 . "text") (8 . "GiCAD_SDYX"))))
  8.     (progn
  9.       (setq lst        (mapcar
  10.                   '(lambda (x)
  11.                      (list (car (test (get_object_reactor x)))
  12.                            (list (xdrx_getpropertyvalue x "Textstring") x)
  13.                      )
  14.                    )
  15.                   (xdrx_pickset->ents ss)
  16.                 )
  17.             lst        (XD::List:GroupByIndex lst 0)
  18.             lst        (XD::List:GroupByIndex
  19.                   (mapcar '(lambda (x)
  20.                              (list (mapcar 'car x)
  21.                                    (mapcar 'cadr x)
  22.                              )
  23.                            )
  24.                           (mapcar 'cdr lst)
  25.                   )
  26.                   0
  27.                 )
  28.             lst        (mapcar        '(lambda (x)
  29.                            (cons (strcat "0011镡"
  30.                                          (xdrx_string_join
  31.                                            (acad_strlsort (car x))
  32.                                            "镡"
  33.                                          )
  34.                                  )
  35.                                  (cdr x)
  36.                            )
  37.                          )
  38.                         lst
  39.                 )
  40.             ms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
  41.       )
  42.       (mapcar '(lambda (x)
  43.                  (xdrx_block_make
  44.                    (car x)
  45.                    (XD::Entity->Pickset (cadr x))
  46.                    (_center (cadr x))                  
  47.                    t
  48.                  )
  49.                  (mapcar '(lambda (a)
  50.                             (vla-insertblock
  51.                               ms
  52.                               (vlax-3d-point (_center a))
  53.                               (car x)
  54.                               1.
  55.                               1.
  56.                               1.
  57.                               0.
  58.                             )
  59.                           )
  60.                          (cddr x)
  61.                  )
  62.                )
  63.               lst
  64.       )
  65.       (xdrx_entity_delete ss)
  66.     )
  67.   )
  68.   (princ)
  69. )

点评

API的 INSERT_MAKE如何不稳定,请到API论坛发个帖子说明下,以后完善 。  详情 回复 发表于 2014-4-1 10:11
(8 . "GiCAD_SDYX") 而且,老师,你总是将它限定在上面图层中。我的目标是所有图层的块或组,只要所有文本内容相同,都进行编辑  详情 回复 发表于 2014-4-1 10:02
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

 楼主| 发表于 2014-4-1 09:58:48 | 显示全部楼层
Free-Lancer 发表于 2014-4-1 09:41
先写一部分分组的,后面就是做块、插入、删除了
用到一个找实体所属组程序
http://bbs.xdcad.net/forum ...

; 错误: no function definition:“TEST
没有这个“TEST”自定义函数啊!”

点评

不注意看!上面帖子有链接 http://bbs.xdcad.net/forum.php?mod=viewthread&tid=127718  详情 回复 发表于 2014-4-1 10:01
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

发表于 2014-4-1 10:01:15 | 显示全部楼层
清风明月10 发表于 2014-4-1 09:58
; 错误: no function definition:“TEST
没有这个“TEST”自定义函数啊!”

不注意看!上面帖子有链接

http://bbs.xdcad.net/forum.php?mod=viewthread&tid=127718

点评

我看了上面的链接,且复制得到了。但链接的自定义函数为“get_object_reactor”,不是“TEST”  详情 回复 发表于 2014-4-1 10:04
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

 楼主| 发表于 2014-4-1 10:02:34 | 显示全部楼层
Free-Lancer 发表于 2014-4-1 09:58
不需要花太多时间,完整代码如下
api 的Insert_make 不稳定,用 vla 方法

(8 . "GiCAD_SDYX")
而且,老师,你总是将它限定在上面图层中。我的目标是所有图层的块或组,只要所有文本内容相同,都进行编辑

点评

自己改啊! 改个过滤器还不会! 组已变,留组已无用,加两句删除  详情 回复 发表于 2014-4-1 10:05
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

 楼主| 发表于 2014-4-1 10:04:21 | 显示全部楼层
Free-Lancer 发表于 2014-4-1 10:01
不注意看!上面帖子有链接

http://bbs.xdcad.net/forum.php?mod=viewthread&tid=127718

我看了上面的链接,且复制得到了。但链接的自定义函数为“get_object_reactor”,不是“TEST”

点评

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

使用道具 举报

发表于 2014-4-1 10:06:37 | 显示全部楼层
清风明月10 发表于 2014-4-1 10:04
我看了上面的链接,且复制得到了。但链接的自定义函数为“get_object_reactor”,不是“TEST”

无语!看下一个帖子

点评

是我眼拙。我以为下面的TEST是举例,所以注释掉了  详情 回复 发表于 2014-4-1 10:09
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

 楼主| 发表于 2014-4-1 10:09:57 | 显示全部楼层
Free-Lancer 发表于 2014-4-1 10:06
无语!看下一个帖子

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

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2024-11-14 20:46 , Processed in 0.408140 second(s), 60 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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