[编程交流] 现有区块的名称

;;----------------------------------------------------------------------------;;
;; LABLE BLOCKS BY NAME MIDPOINT OF BOUNDINB BOX
(defun C:BLKNAME (/ SS e Name LL UR MPT)
  (if (setq SS (ssget '((0 . "INSERT"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq Name (cdr (assoc 2 (entget e))))
      (vla-getboundingbox (vlax-ename->vla-object e) 'minpt 'maxpt)
      (setq LL (vlax-safearray->list minpt)
            UR (vlax-safearray->list maxpt)
            MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2))
      )
      (vl-cmdf "_.Text" "J" "MC" "_non" MPT "0.250" "0" Name) ;change 0.25 to text height you want.
    )
    (prompt "\nNo Blocks Selected")
  )
  (princ)
)