[编程交流] 用chan重新定义块

(defun change-tags-by-prompts (/ acsp adoc att atts att_info blockname
                        block_info bname cur_lst ent find ipt layer
                        new_block obj prompts rot xscale yscale zscale)
 (setq        adoc (vla-get-activedocument
       (vlax-get-acad-object)
       )
acsp (vla-get-block
       (vla-get-activelayout adoc)
       )
)
 (setq ent (car (entsel "\n        ***        Select block to change tags tags: ")))
 (if ent
   (progn
     (setq obj (vlax-ename->vla-object ent))
     (if (eq :vlax-false (vla-get-isdynamicblock obj))
(setq bname (vla-get-name obj))
(setq bname (vla-get-effectivename obj))
)
     (vlax-for        att  (vla-item (vla-get-blocks adoc) bname)
(if (eq (vla-get-objectname att) "AcDbAttributeDefinition")
  (progn (setq prompts (cons (strcase
             (vl-string-translate
               (chr 32)
               (chr 95)
               (vla-get-promptstring att))) prompts)
               )
         (vla-put-tagstring
           att
           (strcase
             (vl-string-translate
               (chr 32)
               (chr 95)
               (vla-get-promptstring att)))))
  )
  )
     (setq prompts (reverse prompts))
     (vlax-for        layout        (vla-get-layouts adoc)
(vlax-for blk  (vla-get-block layout)
  (if (eq (vla-get-objectname blk) "AcDbBlockReference")
    (progn
    (if        (eq :vlax-false (vla-get-isdynamicblock blk))
      (setq blockname (vla-get-name blk))
      (setq blockname (vla-get-effectivename blk))
      )
    (if        (eq bname blockname)
      (progn
        (setq block_info nil)
        (setq ipt    (vla-get-insertionpoint blk)
              layer  (vla-get-layer blk)
              rot    (vla-get-rotation blk)
              xscale (vla-get-xscalefactor blk)
              yscale (vla-get-yscalefactor blk)
              zscale (vla-get-zscalefactor blk)
              )
        (foreach att  (vlax-invoke blk 'Getattributes)
          (setq        att_info (cons (car prompts)
                               (vla-get-textstring att)
                               )
                )
          (setq prompts (cdr prompts))
          (setq block_info (cons att_info block_info))
          )
        (setq block_info (reverse block_info))
        (setq new_block (vla-insertblock acsp ipt bname xscale yscale zscale rot))
        (vla-delete blk)
               (vlax-release-object blk)
        (vla-put-layer new_block layer)
        (setq ats (vlax-invoke new_block 'Getattributes))
        (foreach at  ats
          (if (setq find (assoc (vla-get-tagstring at) block_info))
            (vla-put-textstring at (cdr find)))
          (vla-update at)
            )
          )
        )
      )
    )
  )
)
     )
   )
 (princ)
 )
(defun C:CTP(/)
(change-tags-by-prompts)
(princ) 
)
(vl-load-com)
(princ "\n   ***   Type CTP to execute   **")
(prin1)