重命名块乐筑天下 - Powered by Discuz! Archiver

hosyn 发表于 2022-7-6 06:33:55

重命名块

如何用lisp重命名图形中的块。

alanjt 发表于 2022-7-6 06:37:50

第一：重命名功能不够好吗？

hosyn 发表于 2022-7-6 06:43:15

如果我们想选择block，请查看名称并用lisp8修改）

nod684 发表于 2022-7-6 06:44:50

我用这个老套路，但仍然做的工作。。。

;; RBLOCK.lspv1.0
;;
;; Copyright (c) 1998 by Innovative Programming
;; All Rights Reserved
;;
;; TERMS & AGREEMENT
;; Permission to use, copy, modify, and distribute this software
;; for any purpose and without fee is hereby granted, provided
;; that the above copyright notice appears in all copies and that
;; both copyright notice and this permission notice appears in
;; all supporting documentation.
;;
;; ANY USE OF THIS SOFTWARE IS AT YOUR OWN RISK AND IT IS PROVIDED
;; "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY.ALL IMPLIED WARRANTIES
;; OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF MERCHANTABILITY ARE
;; HEREBY DISCLAIMED.NO LIABILITY FOR CONSEQUENTIAL DAMAGES.IN NO
;; EVENT SHALL INNOVATIVE PROGRAMMING BE LIABLE FOR INCIDENTAL,
;; INDIRECT, OR CONSEQUENTIAL DAMAGES (INCLUDING, WITHOUT LIMITATION,
;; DAMAGES FOR LOSS OF BUSINESS PROFITS, BUSINESS INTERRUPTION, LOSS
;; OF BUSINESS INFORMATION, OR ANY OTHER PECUNIARY LOSS) AS A RESULT
;; OF THE USE OF OR INABILITY TO USE THIS SOFTWARE.
;;
;; PURPOSE:
;; Rename user selected block.
;;
;; OTHER NOTES:
;; None
;;
;; FUTURE REVISIONS:
;; None
;;
;; REVISIONS:
;; 1.09/14/98Released
;;
(defun C:RBLOCK (/ SB SBD OLD_NAME NEW_NAME)
(setq SB NIL)
(while (null SB)
(setq SB (entsel "\nSelect block to RENAME: "))
(if SB
(progn (setq SB(car SB)
               SBD (entget SB)
         )
         (if (= (cdr (assoc 0 SBD)) "INSERT")
         (redraw SB)
         (progn (redraw SB)
                  (setq SB NIL)
                  (princ "\nItem selected is not a block.")
         )
         )
)
(princ "\nNothing selected.Try again.")
)
)
(setq OLD_NAME (cdr (assoc 2 SBD)))
(princ (strcat "\n OLD Block Name: " OLD_NAME))
(setq NEW_NAME (getstring "\n NEW Block Name: "))
(command "rename" "b" OLD_NAME NEW_NAME)
(princ (strcat "\n BLOCK RENAMED TO: " NEW_NAME))
(princ)
)
(princ "\nRBLOCK Loaded.Type RBLOCK to Start.")
(princ)

GP_ 发表于 2022-7-6 06:49:01

我的版本，也适用于动态和匿名块。

;;; file: RB_en.lsp                                              ;;;
;;; data: 22/10/2008                                              ;;;
;;; note: Rename the selected block.                            ;;;
;;;                                                             ;;;
;;; aggiornamento: (Versione 2) - 01/04/2009                      ;;;
;;;          - default sulla casella OK                      ;;;
;;;          - controllo esistenza nome blocco                ;;;
;;;                                                             ;;;
;;; aggiornamento: (Versione 3) - 02/04/2009                      ;;;
;;;          - allargata casella editazione nome blocco       ;;;
;;;                                                             ;;;
;;; aggiornamento: (Versione 4) - 28/10/2012                      ;;;
;;;          - rinomina blocchi dinamici e blocchi anonimi    ;;;
;;;          - creazione di blocchi anonimi                   ;;;
;;;          - inglobamento DCL nel lisp                      ;;;
;;;                                                             ;;;
;;; aggiornamento: (V. 4_en) - 20/05/2013                         ;;;
;;;          - English Version (for CADTutor)                ;;;
;;;                                                             ;;;
;;; autore: Gian Paolo Cattaneo                                  ;;;

(defun c:RB (/ :bb old new dcl_id)
(prompt "\n ") (prompt "\n ") (prompt "\n ")
(if
   (while (not :bb)
      (setvar 'errno 0)
      (setq :bb (car (entsel "\nSelect block to RENAME:")))
      (if (= 7 (getvar 'errno))
            (alert "Nothing selected.Try again.")
      )
      (if (= 'ename (type :bb))
            (if (null (wcmatch (cdr (assoc 0 (entget :bb))) "INSERT"))
               (progn
                  (alert "Item selected is not a block.")
                  (setq :bb nil)
               )
               (progn
                  (setq old (vla-get-effectivename (vlax-ename->vla-object :bb)))
               )
            )
      )
   )
   (progn
      (RB_dcl)
      (while
            (and
               (/= (strcase old) (strcase new))
               (tblsearch "BLOCK" new)
            )
            (alert "A block with this name already exists")
            (RB_dcl)
      )
      (vla-put-Name
            (vla-item
               (vla-get-blocks
                  (vla-get-activedocument
                        (vlax-get-acad-object)
                  )
               )
               old
            )
            new
      )
   )
)
(prompt "\n ") (prompt "\n ") (prompt "\n ")
(princ)
)

(defun RB_dcl ( / DCLname)
(setq DCLname (strcat (getvar 'localrootprefix) "RB_V4_en.dcl"))
(if (not (findfile DCLname)) (crea_dcl_RB))
(if (= POSIZ_DCL_RB nil) (setq POSIZ_DCL_RB (list -1 -1)))
(setq dcl_id (load_dialog DCLname))
(if (not (new_dialog "RB4" dcl_id "" POSIZ_DCL_RB)) (exit))
(setq new old)
(set_tile "new" new)
(action_tile "new" "(setq new $value)")
(start_dialog)
(unload_dialog dcl_id)
)

(defun crea_dcl_RB (/ fn f)
(setq fnDCLname)
(setq f (open fn "w"))
(write-line "RB4:dialog {" f)
(write-line "label = \"RB - Rename Block (Vers. 4_en)\";" f)
(write-line "" f)
(write-line " initial_focus=\"new\";" f)
(write-line "" f)
(write-line " : spacer {}" f)
(write-line " : spacer {}" f)
(write-line " : spacer {}" f)
(write-line "" f)
(write-line " : text {" f)
(write-line " label = \"New Block Name:\";" f)
(write-line " alignment = centered;" f)
(write-line " } " f)
(write-line "" f)
(write-line " : text {" f)
(write-line " label = \"(type:*Uto create an Anonymous Block)\";" f)
(write-line " alignment = centered;" f)
(write-line " } " f)
(write-line "" f)
(write-line " : spacer {}" f)
(write-line "" f)
(write-line " : edit_box {" f)
(write-line " key=\"new\";" f)
(write-line " allow_accept=true;" f)
(write-line " }" f)
(write-line "" f)
(write-line " : spacer {}" f)
(write-line " : spacer {}" f)
(write-line " : spacer {}" f)
(write-line "" f)
(write-line " ok_only;" f)
(write-line "" f)
(write-line " : spacer {}" f)
(write-line " : spacer {}" f)
(write-line " : spacer {}" f)
(write-line "" f)
(write-line " : text { " f)
(write-line " label = \"Copyright©2012-Gian Paolo Cattaneo\";" f)
(write-line " alignment = centered;" f)
(write-line " }" f)
(write-line "" f)
(write-line "}" f)
(close f)
(load_dialog fn)
)
;******************************************************************************
(vl-load-com)
(prompt "\n ") (prompt "\n ") (prompt "\n ")
(princ "\nRename Block (V.4_en) - by Gian Paolo Cattaneo")
(princ "\nTypeRBto Start")
(princ)

BlackBox 发表于 2022-7-6 06:49:58

基于Alan的问题，右键单击重命名有用吗？

neophoible 发表于 2022-7-6 06:54:18

：啊：你为什么问这个？我简要地看了一下你在其他地方的一些相关帖子。我认为这是一个有趣的问题，尤其是考虑到您在使人们更容易更改块名方面已经遇到的所有麻烦。
我对你的问题的回答是否定的，在很多情况下这还不够好。我被我在飞行中遇到的大量匿名街区逼疯了。这里我不是指动态块。也许其中一些匿名块可能是合理的，但许多块非常重要，足以在图形中正确命名。选择一个块来找到它的匿名名称，然后转到“重命名”对话框，在列表中搜索它（我通常需要做两次才能确保），然后将其重命名为更合适的名称，这是一件很麻烦的事情。所以，谢谢你，艾伦，让这类事情变得更容易处理，更自动。也许你应该在这里引用或重复你的解决方案，也许是最新版本？

dbroada 发表于 2022-7-6 06:58:07

我不能代表艾伦，但我认为这是一个公平的开始。我们经常被要求使用“LISP”来完成一些可以使用标准AutoCAD命令轻松完成的事情。你已经给了Vven一个很好的例子来说明重命名命令以外的东西，但是如果OP想要一些简单的东西，他会立即得到回复。这里的很多人不想学习AutoCAD，但很乐意请别人为他们编写一个例程。

BlackBox 发表于 2022-7-6 06:59:48

这在一定程度上是我右键单击重命名插件背后的动机（上面的链接）。。。它允许用户选择单个块（对于此特定示例），右键单击、重命名、块，然后输入新的块名称（显示/提供给-Rename命令的现有块名称）。就是这样。

只有应用于选定实体类型的项目可以通过关联菜单使用，并且只有可以重命名的项目可以在关联菜单项中启用。

https://www.cadtutor.net/forum/attachment.php?attachmentid=41879&stc=1&d=1368555266

neophoible 发表于 2022-7-6 07:03:42

是的，我非常同意。在我理解被问的问题之前，我通常不愿意走得太远。对我来说，第一篇帖子清晰易懂似乎很少见。我很清楚，我不是想批评艾伦。远非如此。在这个特殊的例子中，通过LISP做一件非常有用的事情，即使OP真的不需要它。既然这个问题已经解决了，我认为如果Alan愿意的话，在这里发布或链接这个解决方案是一件好事。顺便说一句，我在另一个论坛上注意到了Alan的解决方案，但我在CADTutor上没有看到。也许我只是错过了？我将试着看一下BlackBox的解，看看我是否能理解它。

页: [1] 2

乐筑天下's Archiver

重命名块