przem_saw 发表于 2022-7-5 22:39:52

块替换名称lisp

大家好，基本上我需要使用lisp例程更改一个块的名称。
我发现：
(defun c:REP (/ ENT1 BL1 bl2 OLD ODNM)
(command "undo" "begin")
(prompt "\nSelect Replacement Block: ")
(setq bl2 (cdr (assoc 2 (entget (car (entsel))))))
(prompt "Select blocks to replace: ")
(setq ENT1 (ssget))
(setq N (sslength ENT1))
(setq I 0)
(repeat N
(setq BL1 (entget (ssname ENT1 I)))
(setq NWNM (cons 2 bl2))
(setq OLD (assoc 2 BL1))
(setq ODNM (cdr OLD))
(entmod (subst NWNM OLD BL1))
(setq I (1+ I))
)
(command "undo" "end")
(princ)
)
 
并尝试对此进行更改：
(defun c:REPT (/ ENT1 BL1 bl2 OLD ODNM)
(command "undo" "begin")
(setq bl2 (getstring "\nType a new name: "))
(prompt "Select blocks to replace: ")
(setq ENT1 (ssget))
(setq N (sslength ENT1))
(setq I 0)
(repeat N
(setq BL1 (entget (ssname ENT1 I)))
(setq NWNM (cons 2 bl2))
(setq OLD (assoc 2 BL1))
(setq ODNM (cdr OLD))
(entmod (subst NWNM OLD BL1))(princ NWNM) (princ old)
(setq I (1+ I))
)
(command "undo" "end")
(princ)
)
但第二个程序不起作用。
有人知道为什么吗？

Tharwat 发表于 2022-7-5 22:49:14

欢迎来到CADTutor。
 
您是在谈论重命名图形中的特定块还是用另一个块替换块？

przem_saw 发表于 2022-7-5 23:02:57

比如说，在图形中有10个块名为Shape1（它们当然是相同的），我想把其中一个块的名称改为Shape2，所以我将有9个块名为Shape1和1个块名为Shape2，它们看起来仍然一样。

Tharwat 发表于 2022-7-5 23:07:00

这是普通街区吗？我的意思是没有属性，甚至没有动态块。

marko_ribar 发表于 2022-7-5 23:20:21

如果是唯一的块引用，请尝试以下代码。。。
 

(defun c:renblref ( / ss n k bl blnl p )

(vl-load-com)

(setq n "")
(while (not (snvalid n))
   (setq n (getstring t "\nSpecify new block reference name: "))
)
(prompt "\nSelect block references to rename")
(setq ss (ssget ":L" '((0 . "INSERT"))))
(setq k -1)
(while (setq bl (ssname ss (setq k (1+ k))))
   (setq blnl (cons (vl-remove-if-not '(lambda ( x ) (member (car x) '(8 2 41 42 43 50 210))) (entget bl)) blnl))
)
(if (not (vl-every '(lambda (x) (equal x (car blnl))) blnl))
   (progn
   (alert "Selected block references with different layers, or names, or scale factors, or rotations, or normals - quitting... Select only unique block references...")
   (exit)
   )
   (progn
   (setq k -1)
   (while (setq bl (ssname ss (setq k (1+ k))))
       (setq p (cdr (assoc 10 (entget bl))))
       (setq p (trans p 0 1))
       (if (eq k 0)
         (progn
         (command "_.explode" bl)
         (while (> (getvar 'cmdactive) 0) (command ""))
         (command "_.copybase" p (ssget "_P") "")
         (command "_.pasteblock" p)
         (command "_.erase" (ssget "_P") "")
         (vla-put-name
             (vla-item (vla-get-blocks
                         (vla-get-activedocument (vlax-get-acad-object))
                     )
                     (vla-get-name (vlax-ename->vla-object (entlast)))
             )
             n
         )
         (vla-auditinfo
             (vla-get-activedocument (vlax-get-acad-object))
             :vlax-true
         )
         (vla-put-name
             (vla-item (vla-get-blocks
                         (vla-get-activedocument (vlax-get-acad-object))
                     )
                     (vla-get-name (vlax-ename->vla-object (entlast)))
             )
             n
         )
         )
         (progn
         (command "_.erase" bl "")
         (command "_.insert" n p 1 1 0)
         )
       )
   )
   )
)
(princ)
)
HTH，M.R。

przem_saw 发表于 2022-7-5 23:25:16

谢谢你，这就是我要找的节目！

prodromosm 发表于 2022-7-5 23:35:19

干得好marko_ribar。这个lisp是否可以处理块属性。现在可以了，但是删除里面的所有标签。
 
谢谢
指向图纸

przem_saw 发表于 2022-7-5 23:48:17

试试这个http://www.lee-mac.com/copyblock.html
页: [1]
查看完整版本: 块替换名称lisp