组命令例程
这是一个我一直在寻找很长时间。多年来，我们一直使用AutoCAD LT，然后转向了完整的AutoCAD。LT中的组命令远优于全自动CAD。只需单击一个按钮，拾取对象，然后对其进行分组。单击另一个按钮，它们将被取消分组。然后，使用“pickstyle”选项，您可以暂时挂起组进行编辑。这就是它在其他图形程序（例如CorelDraw、Illustrator、Xara等）中的工作原理。出现了一个对话框，这样我可以“命名”一个组，然后选择对象的整个想法似乎很疯狂。这真的打断了工作流程。如果我想那样做，我会制造障碍。有没有人知道如何使用lisp或其他定制来实现这一点？ 也许使用匿名组？
(defun c:grp ( / l )
(vl-load-com)
;; © Lee Mac 2010
(if (setq l (LM:SS->VLA (ssget)))
(vla-AppendItems
(vla-Add
(vla-get-Groups
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
"*"
)
(LM:ObjectVariant l)
)
)
(princ)
)
;;------------------=={ Safearray Variant }==-----------------;;
;; ;;
;;Creates a populated Safearray Variant of a specified ;;
;;data type ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;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 )
;; © Lee Mac 2010
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray datatype
(cons 0 (1- (length data)))
)
data
)
)
)
;;-------------------=={ Object Variant }==-------------------;;
;; ;;
;;Creates a populated Object Variant ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;lst - list of VLA Objects to populate the Variant. ;;
;;------------------------------------------------------------;;
;;Returns:VLA Object Variant ;;
;;------------------------------------------------------------;;
(defun LM:ObjectVariant ( lst )
;; © Lee Mac 2010
(LM:SafearrayVariant vlax-vbobject lst)
)
;;-----------------=={ SelectionSet -> VLA }==----------------;;
;; ;;
;;Converts a SelectionSet to a list of VLA Objects ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;ss - Valid SelectionSet (Pickset) ;;
;;------------------------------------------------------------;;
;;Returns:List of VLA Objects ;;
;;------------------------------------------------------------;;
(defun LM:ss->vla ( ss )
;; © Lee Mac 2010
(if ss
(
(lambda ( i / e l )
(while (setq e (ssname ss (setq i (1+ i))))
(setq l (cons (vlax-ename->vla-object e) l))
)
l
)
-1
)
)
) 这一个是匿名块。
我不是这个节目的作者。
我在网上搜索时找到了它，效果很好。
史蒂夫J
(princ "\n This code is provided Unscramnbled - for free - given that it is not altered")
(princ "\n Thanks for your understanding, www.xordesign.com ")
(princ "\n Type TBLOCK to start ")
(defun c:TBLOCK (/ sset tell ent ent_get entu ent_getu blk)
(princ "\n Select objects to group into anonymous Block: ")
(setq sset (ssget))
(if sset (progn
(entmake (list
'(0 . "BLOCK")
'(2 . "*U")
'(70 . 1)
'(100.0 0.0 0.0)))
(setq tell 0)
(setq ent (ssname sset tell))
(while ent
(setq ent_get (entget ent))
(if (/= (cdr (assoc 0 ent_get)) "POLYLINE")(progn
(setq ent_getu (cdr ent_get))
(entdel ent)
(entmake ent_getu))
(progn
(setq entu ent
ent_getu (cdr ent_get))
(while (/= (cdr (assoc 0 ent_getu)) "SEQEND")
(setq ent_getu (cdr (entget entu)))
(entmake ent_getu)
(setq entu (entnext entu))
);while
(entdel ent)
)
);if
(setq tell (+ tell 1))
(setq ent (ssname sset tell))
)
(setq blk (entmake (list '(0 . "ENDBLK"))))
(entmake (list '(0 . "INSERT")
(cons 2 blk)
'(10 0.0 0.0 0.0)))
);progn
);if
(princ "\n Anonymous block created. Explode to ungroup")
(princ)
)
(princ)
编辑：李。我一直在尝试你的匿名群组惯例，在我尝试引爆群组之前一切都很好。
不会爆炸。我想你应该知道。
再想一想，我现在可以和同事们玩得无穷无尽了。 这为您提供了匿名或命名块以及基点输入的选项：
;=======================================================================
; GroupNew.Lsp Jan 03, 2008
; New Group Into Block Anon or Named
;================== Start Program ======================================
(princ "\nCopyright (C) 1990-2008, Fabricated Designs, Inc.")
(princ "\nLoading GroupNew v1.0 ")
(setq gra_ nil lsp_file "GroupNew")
;================== Macros =============================================
(defun PDot ()(princ "."))
(PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun gra_smd ()
(SetUndo)
(setq oldlay (getvar "CLAYER")
olderr *error*
*error* (lambda (e)
(while (> (getvar "CMDACTIVE") 0)
(command))
(and (/= e "quit / exit abort")
(princ (strcat "\nError: *** " e " *** ")))
(and (= (logand (getvar "UNDOCTL")8)
(command "_.UNDO" "_END" "_.U"))
(gra_rmd))
gra_var '(("CMDECHO" . 0) ("MENUECHO" . 0)
("MENUCTL" . 0) ("MACROTRACE" . 0)
("OSMODE" . 0) ("SORTENTS" . 119)
("LUPREC" . 2) ("MODEMACRO" . ".")
("BLIPMODE". 0) ("EXPERT" . 0)
("SNAPMODE". 1) ("PLINEWID" . 0)
("ORTHOMODE" . 1) ("GRIDMODE" . 0)
("ELEVATION" . 0) ("THICKNESS". 0)
("FILEDIA" . 0) ("FILLMODE" . 0)
("SPLFRAME". 0) ("UNITMODE" . 0)
("TEXTEVAL". 0) ("ATTDIA" . 0)
("AFLAGS" . 0) ("ATTREQ" . 1)
("ATTMODE" . 1) ("UCSICON" . 1)
("HIGHLIGHT" . 1) ("REGENMODE". 1)
("COORDS" . 2) ("DRAGMODE" . 2)
("DIMZIN" . 1) ("PDMODE" . 0)
("CECOLOR" . "BYLAYER")
("CELTYPE" . "BYLAYER")))
(foreach v gra_var
(and (getvar (car v))
(setq gra_rst (cons (cons (car v) (getvar (car v))) gra_rst))
(setvar (car v) (cdr v))))
(princ (strcat (getvar "PLATFORM") " Release " (ver)))
(princ))
(PDot);++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun gra_rmd ()
(SetLayer oldlay)
(setq *error* olderr)
(foreach v gra_rst (setvar (car v) (cdr v)))
(command "_.UNDO" "_END")
(prin1))
(PDot);++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
(and (zerop (getvar "UNDOCTL"))
(command "_.UNDO" "_ALL"))
(and (= (logand (getvar "UNDOCTL") 2) 2)
(command "_.UNDO" "_CONTROL" "_ALL"))
(and (= (logand (getvar "UNDOCTL")8)
(command "_.UNDO" "_END"))
(command "_.UNDO" "_GROUP"))
(PDot);++++++++++++ Make Layer Current +++++++++++++++++++++++++++++++++
(defun SetLayer (name / ldef flag)
(cond ((or (not name)
(not (snvalid name)))
(princ "\nBad Aurgment Passed To SetLayer - ")
(prin1 name)
(exit)))
(command "_.LAYER")
(if (not (tblsearch "LAYER" name))
(command "_Make" name)
(progn
(setq ldef (tblsearch "LAYER" name)
flag (cdr (assoc 70 ldef)))
(and (= (logand flag1)1)
(command "_Thaw" name))
(and (minusp (cdr (assoc 62 ldef)))
(command "_On" name))
(and (= (logand flag4)4)
(command "_Unlock" name))
(and (= (logand flag 16) 16)
(princ "\nCannot Set To XRef Dependent Layer")
(quit))
(command "_Set" name)))
(command "")
name)
(PDot);************ Main Program ***************************************
(defun gra_ (/ olderr oldlay gra_var gra_rst
bt ss i en ed pt sn sd)
(gra_smd)
(initget "Named Anonymous")
(setq bt (getkword "\nBlock Type - Named/Anonymous <A>: "))
(if (not bt)
(setq bt "Anonymous")
(progn
(setq bn "TEMP1" bc 1)
(while (tblsearch "BLOCK" bn)
(setq bc (1+ bc) bn (strcat "TEMP" (itoa bc))))))
(command "_.SNAP" 1.00)
(initget 1)
(setq pt (getpoint "\nSpecify Base Point: "))
(princ "\nSelect Entities To Block: ")
(and (setq i -1
ss (ssget '((0 . "~VIEWPORT"))))
(entmake (list (cons 0 "BLOCK")
(cons 2 (if (= bt "Named") bn "*U"))
(cons 10 pt)
(cons 70 (if (= bt "Named") 0 1))))
(while (setq en (ssname ss (setq i (1+ i))))
(setq ed (entget en))
(entmake ed)
(and (= 1 (cdr (assoc 66 ed)))
(setq sn en)
(while (/= "SEQEND" (cdr (assoc 0 (entget (entnext sn)))))
(setq sn (entnext sn)
sd (entget sn))
(entmake sd))
(entmake (entget (entnext sn))))
(entdel en))
(setq in (entmake (list (cons 0 "ENDBLK")(cons 8 "0"))))
(entmake (list (cons 0 "INSERT")(cons 2 in)(cons 8 "0")
(cons 10 pt))))
(gra_rmd))
(PDot);************ Load Program ***************************************
(defun C:GroupNew () (gra_))
(if gra_ (princ "\nGroupNew Loaded\n"))
(prin1)
;|================== End Program =======================================
-大卫
我以为这是群体的惯常行为，不是吗？
您应该能够通过“组”对话框分解组
好吧，我会被浸泡！当然，你是对的。
我已经很久没有和组一起工作了，我试着用explode命令将它们解组。我真傻。
史蒂夫J
不用担心SteveJ-直觉上，使用explode命令是有意义的。。。 李，
这真的很有效。这正是我想要的。我想我唯一的问题是。。。有没有可能也解散这些团体？
换句话说。键入grp，然后选择要分组的实体，它将创建组。然后键入ugrp并选择要溶解的组。
我不怎么操纵组对象，但可能是这样的？
(defun c:grp ( / l )
(vl-load-com)
;; © Lee Mac 2010
(or *doc (setq *doc (vla-get-ActiveDocument (vlax-get-acad-object))))
(if (setq l (LM:SS->VLA (ssget)))
(vla-AppendItems
(vla-Add (vla-get-Groups *doc) "*")
(LM:ObjectVariant l)
)
)
(princ)
)
(defun c:ugrp ( / group g h lst )
(vl-load-com)
;; © Lee Mac 2010
(or *doc (setq *doc (vla-get-ActiveDocument (vlax-get-acad-object))))
(vlax-for group (vla-get-Groups *doc)
(vlax-for object group
(setq g (cons (vla-get-Handle object) g))
)
(setq lst (cons (cons group g) lst) g nil)
)
(if lst
(while
(progn
(setq e (car (entsel "\nSelect Object to Remove Grouping: ")))
(cond
(
(eq 'ENAME (type e)) (setq h (vla-get-Handle (vlax-ename->vla-object e)))
(if
(setq group
(vl-some
(function
(lambda ( g )
(if (vl-position h (cdr g)) g)
)
)
lst
)
)
(progn
(vla-delete (car group))
(setq lst (vl-remove group lst))
(princ "\n** Group Deleted **")
)
(princ "\n** Object is not a member of a group **")
)
)
)
)
)
(princ "\n** No Groups in Drawing **")
)
(princ)
)
;;------------------=={ Safearray Variant }==-----------------;;
;; ;;
;;Creates a populated Safearray Variant of a specified ;;
;;data type ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;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 )
;; © Lee Mac 2010
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray datatype
(cons 0 (1- (length data)))
)
data
)
)
)
;;-------------------=={ Object Variant }==-------------------;;
;; ;;
;;Creates a populated Object Variant ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;lst - list of VLA Objects to populate the Variant. ;;
;;------------------------------------------------------------;;
;;Returns:VLA Object Variant ;;
;;------------------------------------------------------------;;
(defun LM:ObjectVariant ( lst )
;; © Lee Mac 2010
(LM:SafearrayVariant vlax-vbobject lst)
)
;;-----------------=={ SelectionSet -> VLA }==----------------;;
;; ;;
;;Converts a SelectionSet to a list of VLA Objects ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;ss - Valid SelectionSet (Pickset) ;;
;;------------------------------------------------------------;;
;;Returns:List of VLA Objects ;;
;;------------------------------------------------------------;;
(defun LM:ss->vla ( ss )
;; © Lee Mac 2010
(if ss
(
(lambda ( i / e l )
(while (setq e (ssname ss (setq i (1+ i))))
(setq l (cons (vlax-ename->vla-object e) l))
)
l
)
-1
)
)
) 李，
很酷！！它工作得很好。非常感谢。
页:
[1]
2