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

清风明月10 · 发表于 2014-4-1 08:19:48

本帖最后由 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个文本内容，以此类推。

Free-Lancer · 发表于 2014-4-1 08:19:49

清风明月10 发表于 2014-4-1 10:02
(8 . "GiCAD_SDYX")
而且，老师，你总是将它限定在上面图层中。我的目标是所有图层的块或组，只要所有文 ...

自己改啊! 改个过滤器还不会!
组已变，留组已无用，加两句删除

(defun c:tt (/ _center ms ss lst gn)
(defun _center (el)
(apply 'xdrx_points_centroid
(apply 'append (mapcar 'xdrx_entity_box el))
)
)
(if (setq ss (ssget '((0 . "text") (8 . "GiCAD_SDYX"))))
(progn
(setq lst (mapcar
'(lambda (x)
(list (car (test (get_object_reactor x)))
(list (xdrx_getpropertyvalue x "Textstring") x)
)
)
(xdrx_pickset->ents ss)
)
lst (XD::List:GroupByIndex lst 0)
gn (mapcar 'car lst)
lst (XD::List:GroupByIndex
(mapcar '(lambda (x)
(list (mapcar 'car x)
(mapcar 'cadr x)
)
)
(mapcar 'cdr lst)
)
0
)
lst (mapcar '(lambda (x)
(cons (strcat "0011镡"
(xdrx_string_join
(acad_strlsort (car x))
"镡"
)
)
(cdr x)
)
)
lst
)
ms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
)
(mapcar '(lambda (x)
(xdrx_block_make
(car x)
(XD::Entity->Pickset (cadr x))
(_center (cadr x))
t
)
(mapcar '(lambda (a)
(vla-insertblock
ms
(vlax-3d-point (_center a))
(car x)
1.
1.
1.
0.
)
)
(cddr x)
)
)
lst
)
(xdrx_entity_delete ss)
(mapcar 'xdrx_group_del gn)
)
)
(princ)
)

(defun c:tt (/ _center ms ss lst gn) 
  (defun _center (el) 
    (apply 'xdrx_points_centroid 
           (apply 'append (mapcar 'xdrx_entity_box el)) 
    ) 
  ) 
  (if (setq ss (ssget '((0 . "text") (8 . "GiCAD_SDYX")))) 
    (progn 
      (setq lst        (mapcar 
                  '(lambda (x) 
                     (list (car (test (get_object_reactor x))) 
                           (list (xdrx_getpropertyvalue x "Textstring") x) 
                     ) 
                   ) 
                  (xdrx_pickset->ents ss) 
                ) 
            lst        (XD::List:GroupByIndex lst 0) 
            gn (mapcar 'car lst) 
            lst        (XD::List:GroupByIndex 
                  (mapcar '(lambda (x) 
                             (list (mapcar 'car x) 
                                   (mapcar 'cadr x) 
                             ) 
                           ) 
                          (mapcar 'cdr lst) 
                  ) 
                  0 
                ) 
            lst        (mapcar        '(lambda (x) 
                           (cons (strcat "0011镡" 
                                         (xdrx_string_join 
                                           (acad_strlsort (car x)) 
                                           "镡" 
                                         ) 
                                 ) 
                                 (cdr x) 
                           ) 
                         ) 
                        lst 
                ) 
            ms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 
      ) 
      (mapcar '(lambda (x) 
                 (xdrx_block_make 
                   (car x) 
                   (XD::Entity->Pickset (cadr x)) 
                   (_center (cadr x))                   
                   t 
                 ) 
                 (mapcar '(lambda (a) 
                            (vla-insertblock 
                              ms 
                              (vlax-3d-point (_center a)) 
                              (car x) 
                              1. 
                              1. 
                              1. 
                              0. 
                            ) 
                          ) 
                         (cddr x) 
                 ) 
               ) 
              lst 
      ) 
      (xdrx_entity_delete ss) 
      (mapcar 'xdrx_group_del gn) 
    ) 
  ) 
  (princ) 
)

Free-Lancer · 发表于 2014-4-1 08:34:08

你用 VBA 写一个

清风明月10 · 发表于 2014-4-1 08:42:25

我的水平无法解决这么复杂的难题。VBA更难写

Free-Lancer · 发表于 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

(defun c:tt (/ _center ss lst)
(defun _center (el)
(apply 'xdrx_points_centroid
(apply 'append (mapcar 'xdrx_entity_box el))
)
)
(if (setq ss (ssget '((0 . "text") (8 . "GiCAD_SDYX"))))
(progn
(setq lst (mapcar
'(lambda (x)
(list (car (test (get_object_reactor x)))
(list (xdrx_getpropertyvalue x "Textstring") x)
)
)
(xdrx_pickset->ents ss)
)
lst (XD::List:GroupByIndex lst 0);_用组名分
lst (XD::List:GroupByIndex
(mapcar '(lambda (x)
(list (mapcar 'car x)
(mapcar 'cadr x)
)
)
(mapcar 'cdr lst)
)
0
);_组内文字是否相同分组
lst (mapcar '(lambda (x)
(cons (strcat "0011镡"
(xdrx_string_join
(acad_strlsort (car x))
"镡"
)
)
(cdr x)
)
)
lst
)
)
)
)
)

(defun c:tt (/ _center ss lst) 
  (defun _center (el) 
    (apply 'xdrx_points_centroid 
           (apply 'append (mapcar 'xdrx_entity_box el)) 
    ) 
  ) 
  (if (setq ss (ssget '((0 . "text") (8 . "GiCAD_SDYX")))) 
    (progn 
      (setq lst        (mapcar 
                  '(lambda (x) 
                     (list (car (test (get_object_reactor x))) 
                           (list (xdrx_getpropertyvalue x "Textstring") x) 
                     ) 
                   ) 
                  (xdrx_pickset->ents ss) 
                ) 
            lst        (XD::List:GroupByIndex lst 0);_用组名分 
            lst        (XD::List:GroupByIndex 
                  (mapcar '(lambda (x) 
                             (list (mapcar 'car x) 
                                   (mapcar 'cadr x) 
                             ) 
                           ) 
                          (mapcar 'cdr lst) 
                  ) 
                  0 
                );_组内文字是否相同分组 
            lst        (mapcar        '(lambda (x) 
                           (cons (strcat "0011镡" 
                                         (xdrx_string_join 
                                           (acad_strlsort (car x)) 
                                           "镡" 
                                         ) 
                                 ) 
                                 (cdr x) 
                           ) 
                         ) 
                        lst 
                ) 
      ) 
    ) 
  ) 
)

newer · 发表于 2014-4-1 09:41:12

清风明月10 发表于 2014-4-1 08:42
我的水平无法解决这么复杂的难题。VBA更难写

美女,你试着写个,LISP.

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

清风明月10 · 发表于 2014-4-1 09:47:46

newer 发表于 2014-4-1 09:41
美女,你试着写个,LISP.

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

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

LoveArx · 发表于 2014-4-1 09:57:51

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

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

Free-Lancer · 发表于 2014-4-1 09:58:40

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

不需要花太多时间，完整代码如下
api 的Insert_make 不稳定，用 vla 方法

(defun c:tt (/ _center ms ss lst)
(defun _center (el)
(apply 'xdrx_points_centroid
(apply 'append (mapcar 'xdrx_entity_box el))
)
)
(if (setq ss (ssget '((0 . "text") (8 . "GiCAD_SDYX"))))
(progn
(setq lst (mapcar
'(lambda (x)
(list (car (test (get_object_reactor x)))
(list (xdrx_getpropertyvalue x "Textstring") x)
)
)
(xdrx_pickset->ents ss)
)
lst (XD::List:GroupByIndex lst 0)
lst (XD::List:GroupByIndex
(mapcar '(lambda (x)
(list (mapcar 'car x)
(mapcar 'cadr x)
)
)
(mapcar 'cdr lst)
)
0
)
lst (mapcar '(lambda (x)
(cons (strcat "0011镡"
(xdrx_string_join
(acad_strlsort (car x))
"镡"
)
)
(cdr x)
)
)
lst
)
ms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
)
(mapcar '(lambda (x)
(xdrx_block_make
(car x)
(XD::Entity->Pickset (cadr x))
(_center (cadr x))
t
)
(mapcar '(lambda (a)
(vla-insertblock
ms
(vlax-3d-point (_center a))
(car x)
1.
1.
1.
0.
)
)
(cddr x)
)
)
lst
)
(xdrx_entity_delete ss)
)
)
(princ)
)

(defun c:tt (/ _center ms ss lst) 
  (defun _center (el) 
    (apply 'xdrx_points_centroid 
           (apply 'append (mapcar 'xdrx_entity_box el)) 
    ) 
  ) 
  (if (setq ss (ssget '((0 . "text") (8 . "GiCAD_SDYX")))) 
    (progn 
      (setq lst        (mapcar 
                  '(lambda (x) 
                     (list (car (test (get_object_reactor x))) 
                           (list (xdrx_getpropertyvalue x "Textstring") x) 
                     ) 
                   ) 
                  (xdrx_pickset->ents ss) 
                ) 
            lst        (XD::List:GroupByIndex lst 0) 
            lst        (XD::List:GroupByIndex 
                  (mapcar '(lambda (x) 
                             (list (mapcar 'car x) 
                                   (mapcar 'cadr x) 
                             ) 
                           ) 
                          (mapcar 'cdr lst) 
                  ) 
                  0 
                ) 
            lst        (mapcar        '(lambda (x) 
                           (cons (strcat "0011镡" 
                                         (xdrx_string_join 
                                           (acad_strlsort (car x)) 
                                           "镡" 
                                         ) 
                                 ) 
                                 (cdr x) 
                           ) 
                         ) 
                        lst 
                ) 
            ms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 
      ) 
      (mapcar '(lambda (x) 
                 (xdrx_block_make 
                   (car x) 
                   (XD::Entity->Pickset (cadr x)) 
                   (_center (cadr x))                   
                   t 
                 ) 
                 (mapcar '(lambda (a) 
                            (vla-insertblock 
                              ms 
                              (vlax-3d-point (_center a)) 
                              (car x) 
                              1. 
                              1. 
                              1. 
                              0. 
                            ) 
                          ) 
                         (cddr x) 
                 ) 
               ) 
              lst 
      ) 
      (xdrx_entity_delete ss) 
    ) 
  ) 
  (princ) 
)

清风明月10 · 发表于 2014-4-1 09:58:48

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

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

Free-Lancer · 发表于 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

清风明月10 · 发表于 2014-4-1 10:02:34

Free-Lancer 发表于 2014-4-1 09:58
不需要花太多时间，完整代码如下
api 的Insert_make 不稳定，用 vla 方法

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

清风明月10 · 发表于 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”

Free-Lancer · 发表于 2014-4-1 10:06:37

清风明月10 发表于 2014-4-1 10:04
我看了上面的链接，且复制得到了。但链接的自定义函数为“get_object_reactor”，不是“TEST”

无语！看下一个帖子

清风明月10 · 发表于 2014-4-1 10:09:57

Free-Lancer 发表于 2014-4-1 10:06
无语！看下一个帖子

是我眼拙。我以为下面的TEST是举例，所以注释掉了

账号		自动登录	找回密码
密码			立即注册

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

最佳答案

点评

评分

点评