[编程交流] 重命名块问题（自动

(defun c:wbout(/ dn pa pawbdn doc bn nn layout i)
(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))        
(setq dn (getvar "dwgname"))
(setq pa (getvar "dwgprefix"))
(setq pawbdn (strcat pa "wb\" dn))
(setq bn "Balloon1") 
(setq nn "Raaaaverad")
(vlax-for layout (vla-get-layouts doc)
                   (vlax-for i (vla-get-block layout)
                             (if (and
                                  (= (vla-get-objectname i) "AcDbBlockReference")
                                   (= (strcase (vla-get-name i)) (strcase bn))
                              )
                   
                
                   ;;;(princ "\nHELLO\n") 
                          (vla-put-name i nn)
                             )
                   )
         )
(princ "\nGOODBAJ\n")
(command "SAVE" pawbdn)
)

(defun c:List-Blocks ()
 (vl-load-com)
 (setq doc (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))
 (setq blks (vlax-get-property doc 'Blocks))
 (setq cnt 0)
 (vlax-for b blks
   (princ (strcat "\nBlock Name: " (vlax-get-property b 'Name) "  -  Count: " (rtos cnt 2 0)))
   (setq cnt (+ 1 cnt)))
 (princ)
 )

(defun c:rename-block ()
 ;Get the Block Definition Collection from the Active Document - Get the Active Document from the Acad Object
 (setq blks (vlax-get-property (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'Blocks))
 ;Prompt the User to Select the Block to Rename
 (princ "\Select Block to Rename: ")
 (setq ss (ssget ":s" '(( 0 . "INSERT"))))
 ;If a Block was selected then proceed
 (if ss
   (progn
     ;Get the Block Reference form the Selection Set
     (setq blk-ref (vlax-ename->vla-object (ssname ss 0)))
     ;Get the Name of the Block - Must use EffectiveName is case it's a Dynamic Block
     (setq eff-name (vlax-get-property blk-ref 'EffectiveName))
     ;Prompt User for New Name and check if the Name Exists - See get-new-name Below
     (setq new-name (get-new-name eff-name blks))
     ;Get the Block Definition from the Block Collection
     (setq blk-def (vla-item blks eff-name))
     ;Catch any unhandled exceptions
     (setq msg (vl-catch-all-apply 'vlax-put-property (list blk-def 'Name new-name)))
     ;If msg is an error Display the error
     (if (vl-catch-all-error-p msg)
(alert (vl-catch-all-error-message msg))
(princ (strcat "\nBlock " eff-name " has been renamed to " new-name "."))
)
     )
   )
 (princ)
 )
(defun get-new-name (eff-name blks / new-name msg)
 ;Display the Current Name of the Block
 (princ (strcat "\nCurrent Name: " eff-name))
 ;Prompt for a New Name
 (setq new-name (getstring T "\nEnter New Name for Block: "))
 ;Catch any unhandled exceptions
 (setq msg (vl-catch-all-apply 'vla-item (list blks new-name)))
 ;If an error is not produced then the block name already exists
 (if (vl-catch-all-error-p msg)
   new-name
   (progn
     ;Let user know that the new name already exists as a block name
     (princ (strcat "\n" new-name " already exists."))
     ;Pompt the user to select a new name
     (get-new-name eff-name blks)
     )
   )
 )