[编程交流] 使块引用名称 Unqiue

;;----------------------------------------------------------------------------;;
;; make unique block names
(defun C:UB (/ blk blkname ss en name ss1 ptslst LL UR MPT)
  (vl-load-com)
  (setq ss1 (ssadd)
        blk (car (entsel "\nSelect Block")) ;no error testing so make sure you select a block
        blkname (cdr (assoc 2 (entget blk)))
        i 1
  )
  (if (and (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 blkname) '(410 . "Model")))) (> (sslength ss) 1))
    (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq LastEnt (entlast))
      (setq LL nil UR nil MPT nil ptslst nil)
      (command "_.Explode" blk)
      (if (setq en (entnext LastEnt))
        (while en
          (ssadd en SS1)
          (setq obj (vlax-ename->vla-object en))
          (vla-getboundingbox obj 'minpt 'maxpt)
          (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
                ptslst (cons (vlax-safearray->list maxpt) ptslst)
          )
          (setq en (entnext en))
        )
      )
      (setq LL (apply 'mapcar (cons 'min ptslst))
            UR (apply 'mapcar (cons 'max ptslst))
            MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2))
      )
      (while (tblsearch "BLOCK" (strcat blkname "-" (itoa i)))
        (setq i (1+ i))
      )
      (setq name (strcat blkname "-" (itoa i)))
      (vl-cmdf "_.Block" name "_non" MPT SS1 "")
      (vl-cmdf "_.Insert" name "_non" MPT 1 1 0)
    )
  )
)

(defun c:ub (/ b s)
  (if (and (setq b (car (entsel "\nSelect Block")))
           (= "INSERT" (cdr (assoc 0 (entget b))))
           (setq s (ssget "_X" (list '(0 . "INSERT") (assoc 2 (entget b)))))
      )
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (vla-converttoanonymousblock (vlax-ename->vla-object e))
    )
  )
  (princ)
)
(vl-load-com)