Extract the name of a GROUP

I have some unnamed GROUPS in my drawing (eg. "*A503" as in (3 . "*A503"),
"*A506" as in (3 . "*A506"), etc...).

When I type LIST and click one of the groups (in this case 3D lines) I get
this:

========================================================
LINE Layer: "ELEC-UG"
Space: Model space
Handle = 39F2
Group = *A506
from point, X=342195.6551 Y=5778676.2276 Z= 40.1756
to point, X=342200.4757 Y=5778610.5950 Z= 40.6044
In Current UCS, Length = 65.8094, Angle in XY Plane = 175d47'57"
3D Length = 65.8108, Angle from XY Plane = 89d37'36"
Delta X = 4.8206, Delta Y = -65.6326, Delta Z =
0.4288

LINE Layer: "ELEC-UG"
Space: Model space
Handle = 39F3
Group = *A506
from point, X=342200.4757 Y=5778610.5950 Z= 40.6044
to point, X=342197.1424 Y=5778542.3223 Z= 40.5724
In Current UCS, Length = 68.3540, Angle in XY Plane = 182d47'42"
3D Length = 68.3540, Angle from XY Plane = 90d1'36"
Delta X = -3.3333, Delta Y = -68.2726, Delta Z
-0.0320

 

To explode a group, you don't need to do anything but to delete the group entity.

(entdel (cdr(assoc 330 (entget (car(entsel))))))

You may also want to test the entity type before deleting it and add some checking.

 

Andreas,

Give this a try.

;returns a list of group names the entity is a child of,
;innermost first in the list - by Michael Puckett
(defun gnames (ename / key dct rtn)
(setq key (cons 340 ename)
dct (dictsearch (namedobjdict) "acad_group")
)
(while (setq dct (member (assoc 3 dct) dct))
(if (member key (entget (cdadr dct)))
(setq rtn (cons (cdar dct) rtn))
)
(setq dct (cddr dct))
)
(reverse rtn)
) ;end

Example:
Command: (gnames (car (entsel)))
Select object: ("*A27")

Joe Burke

 

Here's my learning effort.

Code:

(defun c:XpldGroup (/ EnamLt GrpAll GrpLst GrpMem NamLst OkLst)
;---;
(vl-load-com)
(setvar "cmdecho" 0)
;;;
(setq GrpMem (entget (car (entsel "\nPick a group member.")))          ;entity in group.
)
(if (and GrpMem
(= (cdr (assoc 102 GrpMem)) "{ACAD_REACTORS")                      ;if has reactors.
)
(progn
(setq GrpLst (vl-remove-if 'null (mapcar '(lambda (a)(if (= (car a) 330)(cdr a))) GrpMem))
GrpLst (vl-remove-if 'null (mapcar '(lambda (a)(if (= (cdr (assoc 0 (entget a))) "GROUP") a)) GrpLst))
GrpAll (dictsearch (namedobjdict) "ACAD_GROUP")
NamLst (vl-remove-if 'null (mapcar '(lambda (a)(if (= (car a) 3)(cdr a))) GrpAll))    ;group name list.
EnamLt (vl-remove-if 'null (mapcar '(lambda (a)(if (= (car a) 350)(cdr a))) GrpAll))  ;entity name list.
)
(princ (strcat "\n < " (itoa (length GrpLst)) " > Group(s) Found."))
(foreach n GrpLst                                                    ;entity may belong to more than one group.
(if (setq OkLst (member n EnamLt))
(progn
(vla-delete (vlax-ename->vla-object (nth (- (length EnamLt)(length OkLst)) EnamLt))) ;All groups picked entity(if (wcmatch (getvar "cmdnames") "QSAVE") ....

(princ (strcat "\n " (nth (- (length EnamLt)(length OkLst)) NamLst) " exploded."))
)
)
)
)                                                                   ;progn
(princ "\nNo groups found.")
)                                                                     ;end if
;---;
(setvar "cmdecho" 1)
(princ)
)

Bill

 

Thanks guys for all your efforts.

All your examples have been useful and have now solved my problems.

Regards

Andreas

 

Here's a variant I just penned that uses only Visual
LISP thus in theory should work with ObjectDBX docs,
though not tested.

Note that you have to provide an object, not an ename
and a valid document. While you could query the object
for its document via (vla-get-document object) it would
impose a performance penalty if executing the function
against a suite of objects. In that same avenue of thought
you could combine the two functions per GroupNames2 but
I believe better performance will be realized by discrete
functions. I'd test and bench this stuff but I don't have
time right now (apologies).

Code:

;;=====================================================================
;;
;;  (IsMemberOfCollection object collection)
;;
;;  typical result: t or nil
;;
;;  © 2005 Michael Puckett
;;
;;=====================================================================

(defun IsMemberOfCollection ( object collection / isMember )
(vl-catch-all-apply
'(lambda ()
(vlax-for item collection
(cond
(   (equal object item)
(setq isMember t)
(exit)
)
)
)
)
)
isMember
)

;;=====================================================================
;;
;;  (GroupNames object document)
;;
;;  typical result: ("*A1" "*A2" "*A3" ...) or nil
;;
;;  © 2005 Michael Puckett
;;
;;  Note: relies on IsMemberOFCollection function
;;
;;=====================================================================

(defun GroupNames ( object document / names )
(vlax-for group (vlax-get-property document 'Groups)
(if (IsMemberOFCollection object group)
(setq names
(cons
(vlax-get-property group 'name)
names
)
)
)
)
(reverse names)
)

;;=====================================================================
;;
;;  (GroupNames2 object document)
;;
;;  typical result: ("*A1" "*A2" "*A3" ...) or nil.
;;
;;  © 2005 Michael Puckett
;;
;;  Note: Stand alone variant for demonstration purposes
;;
;;=====================================================================

(defun GroupNames2 ( object document / result )
(vlax-for group (vlax-get-property document 'Groups)
(if
(   (lambda ( / isMember )
(vl-catch-all-apply
'(lambda ()
(vlax-for item group
(cond
(   (equal object item)
(setq isMember t)
(exit)
)
)
)
)
)
isMember
)
)
(setq result
(cons
(vlax-get-property group 'Name)
result
)
)
)
)
(reverse result)
)

 

Three things based on a very quick test --

(1) I found there was no appreciable performance gain
going with separate functions.

(2) As theorized works with ObjectDBX.

(3) Using lambda performs better (it should) than a
vanilla quoted list (see GroupNames3) by approx
30%.

So, self reliant version it is ...

Code:

;;=====================================================================
;;
;;  (GroupNames object document)
;;
;;  typical result: ("*A1" "*A2" "*A3" ...) or nil.
;;
;;  © 2005 Michael Puckett
;;
;;=====================================================================

(defun GroupNames ( object document / names )
(vlax-for group (vlax-get-property document 'Groups)
(if
(   (lambda ( / isMember )
(vl-catch-all-apply
'(lambda ()
(vlax-for item group
(if (equal object item)
(progn
(setq isMember t)
(exit)
)
)
)
)
)
isMember
)
)
(setq names
(cons
(vlax-get-property group 'Name)
names
)
)
)
)
(reverse names)
)

;;=====================================================================
;;
;;  (GroupNames3 object document)
;;
;;  typical result: ("*A1" "*A2" "*A3" ...) or nil.
;;
;;  © 2005 Michael Puckett
;;
;;  Note: Variant for demonstration purposes only
;;
;;=====================================================================

(defun GroupNames3 ( object document / result )
(vlax-for group (vlax-get-property document 'Groups)
(if
(  '(   ( / isMember )
(vl-catch-all-apply
'(lambda ()
(vlax-for item group
(if (equal object item)
(progn
(setq isMember t)
(exit)
)
)
)
)
)
isMember
)
)
(setq result
(cons
(vlax-get-property group 'Name)
result
)
)
)
)
(reverse result)
)

<snip>

 

Thanks for the demos Michael.

"Michael Puckett" <> wrote in message news:42026f64_2@newsprd01...

 

You're welcome Doug (and thank you).

 

You might find this a bit faster than the
approach Michael takes. That's mainly because
its speed is not proportional to the number of
groups/members.

Since groups are persistent reactors on their
member entities, the entity data list of each
entity holds the entity names of all groups it
is a member of, so there is really no need to
search each group for the entity.

In a drawing with a very large number of
groups (or a few groups with many members,
take your pick), the manual search approach
can take significantly longer than this (which
itself is based on an ObjectARX/ C++ solution
that I've been using for quite some time).

(defun getgroups (object / data res obj)
(setq data
(member '(102 . "{ACAD_REACTORS")
(entget (vlax-vla-object->ename object))
)
)
(while (and (setq data (cdr data))
(not (equal (car data) '(102 . "}")))
)

(if (eq (caar data) 330)
(vl-catch-all-apply
'(lambda ()
(setq obj
(vlax-ename->vla-object (cdar data))
)
(if (eq (vla-get-ObjectName obj) "AcDbGroup")
(setq res (cons (vla-get-Name obj) res))
)
)
)
)
)
res
)

 

Hi Tony. Interesting information. Thanks for the post.

Before I penned the activex version I had written this,
thought you might find it interesting --

Code:

(defun GroupNames ( ename )
(vl-remove-if 'null
(mapcar
'(lambda ( pair / ename data )
(if
(and
(eq 330 (car pair))
(setq data (entget (setq ename (cdr pair))))
(eq "GROUP" (cdr (assoc 0 data)))
)
(vlax-get-property
(vlax-ename->vla-object ename)
'Name
)
)
)
(entget ename)
)
)
)

I'm guessig it will out perform yours by a factor of 2:1 in my favor.

 

This should perform better yet

Code:

(defun GroupNames ( ename / data names )
(foreach pair
(member
(assoc 330
(setq data
(reverse (entget ename))
)
)
data
)
(if (eq 330 (car pair))
(if (eq "GROUP"
(cdr
(setq data
(entget
(setq ename (cdr pair))
)
)
)
)
(cons
(vlax-get-property
(vlax-ename->vla-object ename)
'Name
)
names
)
)
)
)
names
)

<snip>

 

Michael - My guess is that you weren't 'guessing' about
the speed.

Shame you didn't use a realistic test case in your 'guessing'
(for example, a topo plan with hundreds of LWPOLYLINES,
each with hundreds of vertices; or MTEXT with hundreds of
lines of text, and so on).

If you had, you'd have seen quite a different result (exactly
the opposite of what you 'guessed' .

I noticed that you made a few posts that were mainly
focused on performance issues of that code you posted.

Out of curiosity, given your apparent obsession with
performance, why post the slowest possible solution,
rather than the one you claim to have written before it?

 

I'll guess it doesn't perform any better, based on
nothing but looking at it, and specifically, the use
of (reverse) on a (how long?) entity data list.

FWIW: Here's what you get with a 250 vertex
LWPOLYINE:

Command: polygon
Enter number of sides <1000>: 250

Specify center of polygon or [Edge]:
Enter an option [Inscribed in circle/Circumscribed about circle] <I>:

Specify radius of circle:
Command:
Command: (setq e (entlast) o (vlax-ename->vla-object e))
#<VLA-OBJECT IAcadLWPolyline 05d518c4>

Command: (time '(repeat 1000 (getgroups o)))
2.03302

Command: (time '(repeat 1000 (groupnames e)))
3.02497

While these kind exchanges used to be interesting,
these days, they've become rather old and boring.
Perhaps that's because I view any kind of obsession
with performance of code written in one of the slowest
languages around, to be rather silly, not to mention
a bit oxymoronic.

So, please excuse any perceived lack of enthusiasm on
my part ;-)

 

You are correct, the last one I penned is slower by about
40%.

But the one I wrote years ago, namely

Code:

(defun gnames ( ent / key dct rtn )
(setq
key (cons 340 ent)
dct (dictsearch (namedobjdict) "acad_group")
)
(while (setq dct (member (assoc 3 dct) dct))
(if (member key (entget (cdadr dct)))
(setq rtn (cons (cdar dct) rtn))
)
(setq dct (cddr dct))
)
(reverse rtn)
)

Beats your latest by a very wide margin (like 4 times
faster), particulary when benching with mega vertex
lwpolylines.

Incidentally, the only reason I had posted the activex
variant is that I wanted to try something new, and in
particular something that I felt comfortable using with
ObjectDBX. While you can use entget with ObjectDBX (don't
try entmods though!) I wanted a pure activex version. I
know you find this all rather droll but if you sincerely
want to contribute to the dicussion I invite you to pen
a purely activex version (only vla/vlax calls).

 

As I mentioned earlier, the speed of code that searches
groups for an entity is proportional to the number of
groups and members.

So, what I find odd about your claim, is that it
would have to be based on extensive testing that
involved a drawing with many groups (or the average
for your working environment), and numerous searches
for different entities chosen at random, as that is the
only way to simulate a realistic usage scenario.

So, what is your claim based on? Do you have an
average number of groups/drawing, and an average
number of members/group? What are they? Is the
entity you're looking for always the first entity in the
first group searched, or the last entity in the last
group searched, or is it somewhere 'in the middle' ?

If what you're attempting to say here, is that your
code that searches groups for a member, is faster
in a drawing with 3 groups, each having half-a-dozen
entities, I wouldn't consider that a legitmate claim.

 

Thanks Tony. Will study it.

 

You make very good points Tony. As such, I revisited my
various variants and compared their performances with a
typical piping model with approx 4000 groups.

A modified version of one of my earlier efforts yields
results I'm very happy with (works w/ObjectDBX too if you
convert the ename to a vla-object before the call):

Code:

(defun GroupNames ( ename / data names )
(foreach pair
(vl-remove-if-not
'(lambda (pair) (eq 330 (car pair)))
(member
(assoc 330 (setq data (reverse (entget ename))))
data
)
)
(if (member
'(0 . "GROUP")
(entget (setq ename (cdr pair)))
)
(setq names
(cons
(vlax-get-property
(vlax-ename->vla-object ename)
'Name
)
names
)
)
)
)
names
)

Thank you Tony, I appreciate your contribution(s) to this
discussion.

 

I'm even happier with this variant:

Code:

(defun GroupNames ( ename )
(   (lambda ( data / pair ename names )
(while (setq pair (assoc 330 data))
(if (member
'(0 . "GROUP")
(entget (setq ename (cdr pair)))
)
(setq names
(cons
(vlax-get-property
(vlax-ename->vla-object ename)
'Name
)
names
)
)
)
(setq data (cdr (member pair data)))
)
(reverse names) ;; return in order of nesting
)
(entget ename)
)
)

Open forum challenge: Write a faster one.

<snip>

 

Only as variant, without any claims.

Code:

(defun ent-ungroup (ent switch / obj)
(if (and ent
(setq groups	(mapcar	(function (lambda (d)
(vlax-ename->vla-object (cdr (assoc -1 d)))
)
)
(vl-remove-if-not
(function (lambda (c) (= (cdr (assoc 0 c)) "GROUP")))
(mapcar (function (lambda (b) (entget (cdr b))))
(vl-remove-if-not
(function (lambda (a) (= (car a) 330)))
(entget ent)
)
)
)
)
)
)
(mapcar (if	switch
(function vla-delete)
(function vla-get-name)
)
groups
)
)
)

;|
(ent-ungroup (car (entsel)) nil) ;_ get list names of the groups (may be more then one)
(ent-ungroup (car (entsel)) t)   ;_ delete groups
|;

Best regards!