[编程交流] 具有访问权限的活动命令

(   (setq *rev*
               (cond
                   (   (= "" (setq rv (getstring t (strcat "\nSpecify Revision Number" (if *rev* (strcat " <" *rev* ">: ") ": ")))))
                       *rev*
                   )
                   (   rv   )
               )
           )                     
           (command "_.revcloud")
           (while (= 1 (logand 1 (getvar 'cmdactive))) (command "\"))
           (setvar 'cmdecho 0)
           (setvar 'attreq  0)
           (setq el (entlast))
           (princ "\nSpecify Insertion Point for Revision Block: ")
           (command "_.-insert" bn "_S" 1.0 "_R" 0.0 "\")
           (if (not (eq el (setq el (entlast))))
               (progn
                   (setq el (entget (entnext el)))
                   (if (entmod (subst (cons 1 *rev*) (assoc 1 el) el))
                       (entupd (cdr (assoc -1 el)))
                   )
               )
           )

(defun c:rv ( / *error* doc layers ent ar bn cm el fn rv )
(vl-load-com)
;;Set the active document
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
;;Set the active layer list
(setq layers (vla-get-layers (vla-get-ActiveDocument(vlax-get-acad-object))))
;;Get the current layer and store it for reuse
(setq olayer (vlax-variant-value (vla-getvariable (vla-get-activedocument (vlax-get-acad-object)) "clayer")))
;;Set start of undo mark
   (vla-startundomark doc)
;;Create the layer for revisions if it does not exist
   (foreach lay '("T-ANNO-REVS-TEXT")
       (   (if (setq ent (tblobjname "layer" lay))
               (lambda ( lst ) (entmod (cons (cons -1 ent) lst)))
               entmake
           )
           (list
              '(000 . "LAYER")
              '(100 . "AcDbSymbolTableRecord")
              '(100 . "AcDbLayerTableRecord")
              '(070 . 0)
              '(062 . 241)
               (cons 002 lay)
           )
       )
   )
(vlax-for l layers 
(progn
        
       (member (strcase (vla-get-name l)) '("T-ANNO-REVS-TEXT"))
        (vlax-put-property l 'PlotStyleName "B040(7)")
)
)
;;set layer to T-ANNO-REVS-TEXT
(setvar "CLAYER" "T-ANNO-REVS-TEXT")
;;Set the revision cloud attribute block
   (setq bn "revisionblock")
   
;;Error handling for break, cancel, or exit
   (defun *error* ( msg )
       (if cm (setvar 'cmdecho cm))
       (if ar (setvar 'attreq ar))
       (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
           (princ (strcat "\nError: " msg))
                (setvar "CLAYER" olayer)
       )
       (princ)
   )
   (setq cm (getvar 'cmdecho)
         ar (getvar 'attreq)
   )
   (cond
       (   (not
               (or (tblsearch "BLOCK" bn)
                   (and
                       (setq fn (findfile (strcat bn ".dwg")))
                       (progn
                           (setvar 'cmdecho 0)
                           (command "_.-insert" fn nil)
                           (setvar 'cmdecho cm)
                           (tblsearch "BLOCK" bn)
                       )
                   )
               )
           )
           (princ (strcat "\n" bn ".dwg not found."))
       )
       (   (zerop (logand 2 (cdr (assoc 70 (tblsearch "BLOCK" bn)))))
           (princ (strcat "\n" bn " not attributed."))
       )
       (   (setq *rev*
               (cond
                   (   (= "" (setq rv (getstring t (strcat "\nSpecify Revision Number" (if *rev* (strcat " <" *rev* ">: ") ": ")))))
                       *rev*
                   )
                   (   rv   )
               )
           )                     
           (command "_.revcloud")
           (while (= 1 (logand 1 (getvar 'cmdactive))) (command "\"))
           (setvar 'cmdecho 0)
           (setvar 'attreq  0)
           (setq el (entlast))
           (princ "\nSpecify Insertion Point for Revision Block: ")
           (command "_.-insert" bn "_S" 1.0 "_R" 0.0 "\")
           (if (not (eq el (setq el (entlast))))
               (progn
                   (setq el (entget (entnext el)))
                   (if (entmod (subst (cons 1 *rev*) (assoc 1 el) el))
                       (entupd (cdr (assoc -1 el)))
                   )
               )
           )
           (setvar 'attreq  ar)
           (setvar 'cmdecho cm)
       )
   )    
   (princ)
;;Restore old layer
(vla-setvariable (vla-get-activedocument (vlax-get-acad-object)) "clayer" olayer)
;;Set end of undo mark
(vla-endundomark doc)
)
(princ)

(setq olayer (vlax-variant-value (vla-getvariable (vla-get-activedocument (vlax-get-acad-object)) "clayer")))
(setq olayer (getvar "clayer"))
(vla-setvariable (vla-get-activedocument (vlax-get-acad-object)) "clayer" olayer)
(setvar "clayer" olayer)

So I used:
(command "revcloud" "A" (* 0.3125 (getvar "DIMSCALE")) "")
It's probably a bit messy: I'm not the greatest at LISP. After the user runs this once, the arc length will then scale with the dimscale automatically. The trick is telling the tool that the arc length should always be 0.3125 of the dimscale.