求LISP程序：修改块 内文字,块 名自动修改为与文字同名

fengyu6913

求LISP程序：修改块 内文字,块 名自动修改为与文字同名，如图中所述，谢谢大佬

xtjd

vitalgg

块内文字内容不同，不可能是同一个块的。所以直接改这个块的名字就可以了。
但是可能会有冲突。如块名已经存在。文字内有不可用的字符如 ：/\ 等。

1. (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
   
2. (defun rename-by-text ()
   
3.   (prompt "请选择块参照")
   
4.   (setq blkrefs (pickset:to-list (ssget '((0 . "INSERT")))))
   
5.   (prompt (strcat "选中了" (itoa (length blkrefs)) "个块参照。"))
   
6.   (foreach blkref blkrefs
   
7.     ;;取块内文字内容
   
8.     (setq ens-in-blk (block:ent-list (entity:getdxf blkref 2)))
   
9.     (while
   
10.       (and
    
11.         (setq en (car ens-in-blk))
    
12.         (not (eq (entity:getdxf en 0) "TEXT")))
    
13.       (setq ens-in-blk (cdr ens-in-blk)))
    
14.     (if
    
15.       (and
    
16.         (setq en (car ens-in-blk))
    
17.         (eq (entity:getdxf en 0) "TEXT"))
    
18.       (vla-put-name
    
19.         (block:get-obj-by-name (entity:getdxf blkref 2))
    
20.         (entity:getdxf en 1)))))

(progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))<br /> (defun rename-by-text () <br />   (prompt "请选择块参照")<br />   (setq blkrefs (pickset:to-list (ssget '((0 . "INSERT")))))<br />   (prompt (strcat "选中了" (itoa (length blkrefs)) "个块参照。"))<br />   (foreach blkref blkrefs <br />     ;;取块内文字内容<br />     (setq ens-in-blk (block:ent-list (entity:getdxf blkref 2)))<br />     (while <br />       (and <br />         (setq en (car ens-in-blk))<br />         (not (eq (entity:getdxf en 0) "TEXT")))<br />       (setq ens-in-blk (cdr ens-in-blk)))<br />     (if <br />       (and <br />         (setq en (car ens-in-blk))<br />         (eq (entity:getdxf en 0) "TEXT"))<br />       (vla-put-name <br />         (block:get-obj-by-name (entity:getdxf blkref 2))<br />         (entity:getdxf en 1)))))

另：你这可以直接改成属性定义啊。

kozmosovia

属性用字段就是了，将来直接改块名自动映射到属性。不需要一行代码
https://www.bilibili.com/video/B ... id_from=333.999.0.0

fengyu6913

xtjd 发表于 2024-5-27 09:25

感谢大佬帮忙解决

白山茶

xtjd 发表于 2024-5-27 09:25

大佬，用不了了，不知道为啥，提示错误。

阿猪蛋

感谢大佬帮忙解决