[编程交流] 将标注复制到文字替代

;;Dim override
(defun c:dimo (/ COPYDIM CURLAY DELSET DIMLST
      DIMSET ERRCOUNT LAYCOL LENT
      NEXTENT OVTEXT *ERROR* ACTDOC
      OLDECHO)
;;; Vladimir Smirnov {Smirnoff} on dwg.ru
 (defun *ERROR* (msg)
   (setvar "CMDECHO" oldEcho)
   ); end of error
 (vl-load-com)
 (setq oldEcho(getvar "CMDECHO")
actDoc(vla-get-ActiveDocument
              (vlax-get-acad-object))
layCol(vla-get-Layers actDoc)
); end setq
 (setvar "CMDECHO" 0)
 (if
   (setq dimSet
   (ssget '((0 . "DIMENSION"))))
   (progn
     (setq dimLst
     (mapcar 'vlax-ename->vla-object 
                   (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex dimSet))))
    errCount 0
    ); end setq
     (vla-StartUndoMark actDoc)
     (foreach dim dimLst
(setq curLay(vla-get-Layer dim))
(if
  (/= :vlax-true
      (vla-get-Lock(Col_Item_Find layCol curLay)))
  (progn
(setq lEnt(entlast)
      delSet(ssadd)
      copyDim(vla-Copy dim)
      ); end setq
(command "_.Explode"(entlast))
 (setq nextEnt(entnext lEnt))
(while nextEnt
  (ssadd nextEnt delSet)
  (if
    (member
      (cdr(assoc 0(entget nextEnt)))
      '("TEXT" "MTEXT")); end member
    (setq ovText
           (cdr(assoc 1(entget nextEnt))))
    ); end if
  (command "_.erase" nextEnt "")
  (setq nextEnt(entnext nextEnt))
    ); end whlie
(vla-put-TextOverride dim ovText)
(vla-put-Color dim 22)
); end progn
  (setq errCount(1+ errCount))
  ); end if
); end foreach
     (if(/= 0 errCount)
(princ
  (strcat "\n"
          (itoa errCount)" were on locked layer!"))
); end if
     (vla-EndUndoMark actDoc)
     ); end progn
   ); end if
 (setvar "CMDECHO" oldEcho)
 (princ)
 ); end of c:dimr
(defun Col_Item_Find (Collection Item / result)
 (if
   (not
     (vl-catch-all-error-p  
(setq result
       (vl-catch-all-apply 'vla-item
         (list Collection Item))))) 
   result
   ); end if
 ); end of Col_Item_Find
;;; Dim restore
(defun c:dimr (/ COPYDIM CURLAY DELSET DIMLST
      DIMSET ERRCOUNT LAYCOL LENT
      NEXTENT OVTEXT *ERROR* ACTDOC
      OLDECHO)
;;; Vladimir Smirnov {Smirnoff} on dwg.ru
 (defun *ERROR* (msg)
   (setvar "CMDECHO" oldEcho)
   ); end of error
 (vl-load-com)
 (setq oldEcho(getvar "CMDECHO")
actDoc(vla-get-ActiveDocument
              (vlax-get-acad-object))
layCol(vla-get-Layers actDoc)
); end setq
 (setvar "CMDECHO" 0)
 (if
   (setq dimSet
   (ssget '((0 . "DIMENSION"))))
   (progn
     (setq dimLst
     (mapcar 'vlax-ename->vla-object 
                   (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex dimSet))))
    errCount 0
    ); end setq
     (vla-StartUndoMark actDoc)
     (foreach dim dimLst
(setq curLay(vla-get-Layer dim))
(if
  (/= :vlax-true
      (vla-get-Lock(Col_Item_Find layCol curLay)))
  (progn
(vla-put-TextOverride dim "<>")
(vla-put-Color dim 82)
); end progn
  (setq errCount(1+ errCount))
  ); end if
); end foreach
     (if(/= 0 errCount)
(princ
  (strcat "\n"
          (itoa errCount)" were on locked layer!"))
); end if
     (vla-EndUndoMark actDoc)
     ); end progn
   ); end if
 (setvar "CMDECHO" oldEcho)
 (princ)
 )
(princ "\nType Dimo to override and Dimr to restore")

(vla-put-Color dim 22)
(vla-put-Color dim 82)

(defun C:ov ( / ss ed dm dm1 )
(setq ss (ssget))
(setq ed (entget (setq e (entlast)))) 
(setq dm (cdr (assoc 42 ed)));get dim value
(setq dm1 (rtos dm 2 0))
(command "dim1" "new" dm1 ss "")
)