Jump to content

Group command routine

Noklu

By Noklu
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Noklu Rookie

Noklu

Posted
Posted

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 Grand Master

Lee Mac

Posted
Posted

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 Collaborator

StevJ

Posted
Posted (edited)

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 by StevJ
David Bethel Grand Master

David Bethel

Posted
Posted

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 Grand Master

Lee Mac

Posted
Posted
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 Collaborator

StevJ

Posted
Posted
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 Grand Master

Lee Mac

Posted
Posted
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 Rookie

Noklu

Posted
  • Author
Posted

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 Grand Master

Lee Mac

Posted
Posted
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 Rookie

Noklu

Posted
  • Author
Posted

Lee,

 

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

  • 6 months later...
mathew21 Contributor

mathew21

Posted
Posted

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 Grand Master

SLW210

Posted
Posted
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 Contributor

mathew21

Posted
Posted

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

mathew21 Contributor

mathew21

Posted
Posted

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?

  • 11 years later...
X11start Enthusiast

X11start

Posted
Posted

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.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...