请问各位高手：后置，前置，这个几个操作的lisp命令都是咋样的？
请问各位高手：后置，前置，这个几个操作的lisp命令都是咋样的？
如题，由于经常用这几个命令。点来点去的很烦。所以我就想搞成lisp调用。
然后我再把一些其他操作再搞成lisp。这样手就不用这么累了。。。
哎，反正都是累。。。一天不知道点几千下。。。
已经解决了。论坛有人问过了。 ;;--------------------=={ Move to Top }==---------------------;;
;; ;;
;;Moves a set of objects to the top of the draw order. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright ?2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;doc- VLA Document Object ;;
;;objs - Selection Set or List of Objects with same owner ;;
;;------------------------------------------------------------;;
;;Returns: T if successful, else nil ;;
;;------------------------------------------------------------;;
(defun LM:MovetoTop ( doc objs / tab )
(if
(and objs
(or
(listp objs)
(setq objs (LM:ss->vla objs))
)
(setq tab (LM:SortentsTable (LM:GetOwner doc (car objs))))
)
(not (vla-movetotop tab (LM:SafearrayVariant vlax-vbobject objs)))
)
)
;;------------------=={ Move to Bottom }==--------------------;;
;; ;;
;;Moves a set of objects to the bottom of the draw order. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright ?2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;doc- VLA Document Object ;;
;;objs - Selection Set or List of Objects with same owner ;;
;;------------------------------------------------------------;;
;;Returns: T if successful, else nil ;;
;;------------------------------------------------------------;;
(defun LM:MovetoBottom ( doc objs / tab )
(if
(and objs
(or
(listp objs)
(setq objs (LM:ss->vla objs))
)
(setq tab (LM:SortentsTable (LM:GetOwner doc (car objs))))
)
(not (vla-movetobottom tab (LM:SafearrayVariant vlax-vbobject objs)))
)
)
;;---------------------=={ Move Above }==---------------------;;
;; ;;
;;Moves a set of objects above a supplied object. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright ?2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;doc- VLA Document Object ;;
;;objs - Selection Set or List of Objects with same owner ;;
;;obj- VLA Object above which to move objects ;;
;;------------------------------------------------------------;;
;;Returns: T if successful, else nil ;;
;;------------------------------------------------------------;;
(defun LM:MoveAbove ( doc objs obj / tab )
(if
(and objs
(or
(listp objs)
(setq objs (LM:ss->vla objs))
)
(setq tab (LM:SortentsTable (LM:GetOwner doc (car objs))))
)
(not (vla-moveabove tab (LM:SafearrayVariant vlax-vbobject objs) obj))
)
)
;;---------------------=={ Move Below }==---------------------;;
;; ;;
;;Moves a set of objects below a supplied object. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright ?2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;doc- VLA Document Object ;;
;;objs - Selection Set or List of Objects with same owner ;;
;;obj- VLA Object below which to move objects. ;;
;;------------------------------------------------------------;;
;;Returns: T if successful, else nil ;;
;;------------------------------------------------------------;;
(defun LM:MoveBelow ( doc objs obj / tab )
(if
(and objs
(or
(listp objs)
(setq objs (LM:ss->vla objs))
)
(setq tab (LM:SortentsTable (LM:GetOwner doc (car objs))))
)
(not (vla-movebelow tab (LM:SafearrayVariant vlax-vbobject objs) obj))
)
)
;;---------------------=={ Swap Order }==---------------------;;
;; ;;
;;Swaps the draw order of two objects (may require regen).;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright ?2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;doc - VLA Document Object ;;
;;obj1,obj2 - VLA Objects to swap ;;
;;------------------------------------------------------------;;
;;Returns: T if successful, else nil ;;
;;------------------------------------------------------------;;
(defun LM:SwapOrder ( doc obj1 obj2 / tab )
(if (setq tab (LM:SortentsTable (LM:GetOwner doc obj1)))
(not (vla-swaporder tab obj1 obj2))
)
)
;;---------------------=={ Get Owner }==----------------------;;
;; ;;
;;Returns the Owner Object of the supplied VLA Object. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright ?2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;obj - VLA Object for which to return owner ;;
;;------------------------------------------------------------;;
;;Returns: Owner Object of supplied VLA Object, else nil ;;
;;------------------------------------------------------------;;
(defun LM:GetOwner ( doc obj )
(if
(and
(vlax-property-available-p obj 'ownerid32)
(vlax-method-applicable-pdoc 'objectidtoobject32)
)
(vla-objectidtoobject32 doc (vla-get-ownerid32 obj))
(vla-objectidtoobject doc (vla-get-ownerid obj))
)
)
;;------------------=={ Sortents Table }==--------------------;;
;; ;;
;;Retrieves the Sortents Table object. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright ?2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;obj - VLA Block Container Object ;;
;;------------------------------------------------------------;;
;;Returns: Sortents Table Object, else nil ;;
;;------------------------------------------------------------;;
(defun LM:SortentsTable ( obj / dic )
(cond
( (LM:CatchApply 'vla-item
(list (setq dic (vla-getextensiondictionary obj)) "ACAD_SORTENTS")
)
)
( (LM:CatchApply 'vla-addobject (list dic "ACAD_SORTENTS" "AcDbSortentsTable")))
)
)
;;-----------------=={ SelectionSet -> VLA }==----------------;;
;; ;;
;;Converts a SelectionSet to a list of VLA Objects ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright ?2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;ss - Valid SelectionSet (Pickset) ;;
;;------------------------------------------------------------;;
;;Returns:List of VLA Objects ;;
;;------------------------------------------------------------;;
(defun LM:ss->vla ( ss / i l )
(if (eq 'pickset (type ss))
(repeat (setq i (sslength ss))
(setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
)
)
)
;;---------------------=={ Catch Apply }==--------------------;;
;; ;;
;;Applies a function to a list of arguments and catches ;;
;;an exception. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright ?2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;_function- function to be applied ;;
;;_params - list of arguments to be supplied to function ;;
;;------------------------------------------------------------;;
;;Returns:Result of function, else nil if exception ;;
;;------------------------------------------------------------;;
(defun LM:CatchApply ( _function _params / result )
(if (not (vl-catch-all-error-p (setq result (vl-catch-all-apply _function _params))))
result
)
)
;;------------------=={ Safearray Variant }==-----------------;;
;; ;;
;;Creates a Safearray Variant of a specified data type ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright ?2012 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;datatype - variant type enum (eg vlax-vbDouble) ;;
;;data - list of static type data ;;
;;------------------------------------------------------------;;
;;Returns:VLA Variant Object of type specified ;;
;;------------------------------------------------------------;;
(defun LM:SafearrayVariant ( datatype data )
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray datatype (cons 0 (1- (length data))))
data
)
)
)
(vl-load-com)
(princ)
;;The following program will move the selected objects to the top of the draw order.
(defun c:top (/)
(LM:MovetoTop (cond (acdoc)
((setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
)
(ssget
(list
(cons 410
(if (= 1 (getvar 'cvport))
(getvar 'ctab)
"Model"
)
)
)
)
)
(princ)
)
;;The following program will move the selected objects to the bottom of the draw order.
(defun c:bottom (/)
(LM:MovetoBottom (cond (acdoc)
((setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
)
(ssget
(list
(cons 410
(if (= 1 (getvar 'cvport))
(getvar 'ctab)
"Model"
)
)
)
)
)
(princ)
)
;;The following program will move the selected objects above the draw order of the subsequently selected object.
(defun c:above (/ ss en)
(if
(and
(setq ss
(ssget
(list
(cons 410
(if (= 1 (getvar 'cvport))
(getvar 'ctab)
"Model"
)
)
)
)
)
(setq en (car (entsel "\nSelect Object to Move Selection Above: ")))
)
(LM:MoveAbove
(cond (acdoc)
((setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
)
ss
(vlax-ename->vla-object en)
)
)
(princ)
)
;;The following program will move the selected objects below the draw order of the subsequently selected object.
(defun c:below (/ ss en)
(if
(and
(setq ss
(ssget
(list
(cons 410
(if (= 1 (getvar 'cvport))
(getvar 'ctab)
"Model"
)
)
)
)
)
(setq en (car (entsel "\nSelect Object to Move Selection Below: ")))
)
(LM:MoveBelow
(cond (acdoc)
((setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
)
ss
(vlax-ename->vla-object en)
)
)
(princ)
)
;;The following program will swap the draw order of the two selected objects; this operation requires a regen to take effect.
(defun c:swap (/ e1 e2)
(if
(and
(setq e1 (car (entsel "\nSelect First Object: ")))
(setq e2 (car (entsel "\nSelect Object to Swap With: ")))
)
(progn
(LM:SwapOrder
(cond (acdoc)
((setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
)
(vlax-ename->vla-object e1)
(vlax-ename->vla-object e2)
)
(vla-regen acdoc acactiveviewport)
)
)
(princ)
)
;;The following program will move all objects residing on the layer of a selected object to the top of the draw order.
(defun c:layertop (/ en)
(if (setq en (car (entsel "\nSelect Object on Layer to Move to Top: ")))
(LM:MovetoTop (cond (acdoc)
((setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
)
(ssget "_X"
(list
(assoc 8 (entget en))
(cons 410
(if (= 1 (getvar 'cvport))
(getvar 'ctab)
"Model"
)
)
)
)
)
)
(princ)
)
;;The following program will move all Hatch objects to the bottom of the draw order.
(defun c:hatchbottom (/)
(LM:MovetoBottom (cond (acdoc)
((setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
)
(ssget "_X"
(list
'(0 . "HATCH")
(cons 410
(if (= 1 (getvar 'cvport))
(getvar 'ctab)
"Model"
)
)
)
)
)
(princ)
)
这样就可以了
((if command-s command-s vl-cmdf) "_.DRAWORDER" SS "" "f") 自贡黄明儒 发表于 2023-3-14 16:33
这样就可以了
((if command-s command-s vl-cmdf) "_.DRAWORDER" SS "" "f")
谢谢黄大侠热心回复。 取走了，感谢分享，今天也遇到这个问题了，点么多次好烦
页:
[1]