具有访问权限的活动命令
大家好，我正在修改我在网上找到的一个LiSP，我已经能够找出我想要更改的大部分内容。我遇到的一个问题是主动命令。当LiSP调用revcloud命令时，我无法访问revcloud设置。如何修改代码以允许此操作。见图片。如果你看这张照片。png你会看到设置显示不同，我注意到我可以键入a、s或t，我可以更改设置，但它们在正常命令下不会显示。（蓝色字母表示要键入的内容，请参阅pic commandsettings.png）我担心这会让用户感到困惑。
任何帮助都将不胜感激。
非常感谢。
( (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 'attreq0)
(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)))
)
)
)
如果你能够完整地发布你的代码，这会有所帮助。当我测试您列出的内容时，我得到了REVCLOUD的选项。 很抱歉，我已经在下面粘贴了完整的代码。请记住，它仍然需要一点清理和TLC。。。
(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 'attreq0)
(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 'attreqar)
(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)
稍微短一点真的不需要使用vl
(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.
页:
[1]