Group command routine

[Noklu]

This is one I have been searching for a long time. For many years we used AutoCAD LT then shifted to full AutoCAD. The Group command in LT was far superior to full AutoCADs. You simply click a button pick your objects and they are grouped. Click another button and they are ungrouped. Then, with the "pickstyle" option you cou temporarily suspend the group for editing. This is basically how it works in other graphics programs (e.g CorelDraw, Illustrator, Xara, etc). The whole idea of a dialog box coming up so I could "name" a group, then select objects seems crazy. It REALLY interrupts the work flow. If I wanted to do that I would make a block.

 

Anyone out there have any ideas how this could be done with a lisp or some other customization?

[Lee Mac]

Perhaps use an anonymous group?

 

(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
   )
 )
)

[StevJ]

This one makes anonymous blocks.

I am not the author of this program.

I found it during an online search, and it works well.

 

SteveJ

 

(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)
                      '(10  0.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)

 

 

EDIT:Lee. I've been experimenting with your anonymous group routine, and all was well until I tried to explode the group.

Will not explode. Thought you should know.

On second thought - I can now have endless "fun" with my co-workers.

Edited November 10, 2010 by StevJ

[David Bethel]

This gives you an option for anonymous or a named block along with the base point input:

;=======================================================================
;    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 flag  1)  1)
            (command "_Thaw" name))
       (and (minusp (cdr (assoc 62 ldef)))
            (command "_On" name))
       (and (= (logand flag  4)  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 =======================================

 

-David

[Lee Mac]

EDIT:Lee. I've been experimenting with your anonymous group routine, and all was well until I tried to explode the group.

Will not explode. Thought you should know.

On second thought - I can now have endless "fun" with my co-workers.

 

I thought this was the usual behaviour with groups, Is it not?

 

You should be able to explode the group through the Group dialog

[StevJ]

You should be able to explode the group through the Group dialog

 

Well I'll be dipped! You're right, of course.

It's been so long since I've worked with groups, I was trying to ungroup them with the explode command. Silly me.

 

SteveJ

[Lee Mac]

Well I'll be dipped! You're right, of course.

It's been so long since I've worked with groups, I was trying to ungroup them with the explode command. Silly me.

 

No worries SteveJ - intuitively, it would make sense to use the explode command...

[Noklu]

Lee,

This works really well. This is exactly what I was looking for. I guess my only quess my only question is... is it possible to my it also dissolve the groups?

in other words. Type grp and you select the entities to group, it makes the group. Then type ugrp and select the group to dissolve.

[Lee Mac]

This works really well. This is exactly what I was looking for. I guess my only question is... is it possible to my it also dissolve the groups?

in other words. Type grp and you select the entities to group, it makes the group. Then type ugrp and select the group to dissolve.

 

I don't manipulate Group objects that much, but perhaps something like this?

 

(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
   )
 )
)

[Noklu]

Lee,

 

VERY COOL!! It works perfectly. Thanks very much.

[Lee Mac]

You're welcome Noklu

[mathew21]

is there anyway to select objects with the quick select tool then group all the objects? i have a map with about 2000 elevations on it and the contour lines and i wanna group each seperatly

or is there a better way to do this?

[SLW210]

is there anyway to select objects with the quick select tool then group all the objects? i have a map with about 2000 elevations on it and the contour lines and i wanna group each seperatly

or is there a better way to do this?

 

I would select them through Qselect and place them on their own layer.

[mathew21]

already done.. i need to be able to move the entire layer so i can try to align them..

[mathew21]

ok i found a way for it to work for me.. i copyed them all pasted them as a block and then moved them back to orginal cords and deleted 1st ones

is there a better way to do this?

[Guest kruuger]

try this one

Lee, do you saw this cursor text before :wink:

kruuger

Group-UnGroup 1.01.lsp

Edited May 16, 2011 by kruuger

[Lee Mac]

Great implementation of GrText Kruuger! I like it!

[X11start]

I resume this old conversation... I use groups to verify that I have selected all blocks that make up a single precast panel. Would it be possible to modify lisp GRP, to also add/remove elements to an existing group? In this moment I use (command "_Group"...) but I would prefer to use the VL-xxx commands but of these I am not expert.