Create a new list from an existing list
A simplified example [read about the functions in the AutoLisp Reference]:
(mapcar 'car '((1 A) (2 B) (3 C) (4 D)))
returns
(1 2 3 4)
Sorry -- itchy trigger finger.
What you describe would probably require something like (vl-sort)ing the list by the second items in the sub-lists, to get those that share insertion points together. That's probably doable, though for points it's probably a multi-stage process, first sorting by X coordinate and then within that by Y coordinate [and then Z if they might differ]. But questions arise: In addition to your listed three with the same insertion point, there's also another pair that share one [the 1st and 3rd in the longer list]. Should the result be two lists in such a case? Or maybe a list of only those of the greatest quantity that share an insertion point? [And what if there are more than one set with the same quantity?] If more than one list, should they be sub-lists nested in a larger containing list?
EDIT: Another approach would be to start with the first item, and step through the list comparing the second item in each sub-list to that of the reference one, putting those that match in a separate list and removing them from the larger list. Then move to the first item that's still in the larger list, and follow the same procedure. Etc.
Hi,
You can try this (corrected code):
(defun groupByPosition (lst fuzz / round roundTo res sub key)
(defun round (num)
(if (minusp num)
(fix (- num 0.5))
(fix (+ num 0.5))
)
)
(defun roundTo (prec num)
(if (zerop (setq prec (abs prec)))
num
(* prec (round (/ num prec)))
)
)
(foreach l lst
(setq res
(if (setq sub
(assoc (setq key
(mapcar
'(lambda (x) (roundTo fuzz x))
(cadr l)
)
)
res
)
)
(subst (vl-list* key (car l) (cdr sub)) sub res)
(cons (list key (car l)) res)
)
)
)
)
with your example,
(groupByPosition lst 0.001)
should return:
(((290156.0 3.26724e+06 0.0)
"<Entity name: 7ef49228>"
)
((290171.0 3.26727e+06 0.0)
"<Entity name: 7ef49230>"
"<Entity name: 7ef405c0>"
"<Entity name: 7ef397b8>"
)
((290253.0 3.26728e+06 0.0)
"<Entity name: 7ef3ed30>"
"<Entity name: 7ef390c0>"
)
)
Wow -- do you actually build a list of [in this case] almost 3500 Block-entity-name-&-Insertion-point pairs?
@neam a écrit :
Dear gile :
Thank you for your attention.
I used your code But I got an error :
## Command: (setq dellist (groupByPosition inslist 1))
## error: no function definition: GC:ROUNDTO
I am posting the code so you can find the error if possible.Thanks a lot.
I corrected the upper code, you can copy it and try again.
Another way is with selection sets rather than lists. This took about 2-1/2 minutes, but reduced your sample drawing from 3462 to 2132 Blocks, and the disappearance of various Block locations was visible, but I didn't really analyze whether it "got it right":
(defun C:RDB ; = Remove Duplicate Blocks
(/ ss ent match ins n ent2 m ent3)
(setq ss (ssget "_X" '((2 . "CAP"))))
(while (> (sslength ss) 1)
(setq
ent (ssname ss 0); first [remaining] one
match (ssadd ent); start selection set with it
ins (getpropertyvalue ent "Position")
); setq
(repeat (1- (setq n (sslength ss)))
(setq ent2 (ssname ss (setq n (1- n))))
(if (equal (getpropertyvalue ent2 "Position") ins 0.01)
(ssadd ent2 match); then -- put it in matching selection
); if
); repeat
(if (> (sslength match) 1); did any others match insertion point?
(repeat (setq m (sslength match)); then -- remove all
(setq ent3 (ssname match (setq m (1- m))))
(ssdel ent3 ss); remove from selection,
(entdel ent3); and from drawing
); repeat
(ssdel ent ss); else [remove reference one from selection only]
); if
); while
(princ)
); defunIt has a fuzz factor for insertion point coordinates built in [0.01], but could be made to ask for that. Likewise with the Block name.
@neam wrote:
Dear kent1 :
It is great.
Thx a lot.
You're welcome. Curiously, one reason I approached it using a selection set for matching insertion points, rather than a list, is that it can make Erasing the things with matching insertion points so much easier [just feed the selection set to an Erase command]. But I ended up stepping through it, instead of using Erase on it collectively, because Erasing doesn't remove the entity names from the original selection set, and that complicates the stepping through of that original set to get Blocks to look for matches with [Blocks removed earlier for matching something else still have their entity names in there]. Stepping through each set of matches allows removing them from both the drawing and the original selection set.
@neam a écrit :
It is very good
Is it possible to list # ONLY # the Entity name ("<Entity name: 7ef49230>") of objects that are # duplicate # without coordinates?
So that I can select and delete them in the list.
If you want only the groups without the 'key' (position):
(mapcar 'cdr (groupByPosition lst 1.))=> ((<Entity name: 7ef49228>) (<Entity name: 7ef49230> <Entity name: 7ef405c0> <Entity name: 7ef397b8>) (<Entity name: 7ef3ed30> <Entity name: 7ef390c0>))
If you want only the enames of duplicated (i.e. remove the first ename of each group):
(mapcar 'cddr (groupByPosition lst 1.))=> (nil (<Entity name: 7ef405c0> <Entity name: 7ef397b8>) (<Entity name: 7ef390c0>))
If you want this in a single flat list:
(apply 'append (mapcar 'cddr (groupByPosition lst 1.)))=> (<Entity name: 7ef405c0> <Entity name: 7ef397b8> <Entity name: 7ef390c0>)
Just a possible other way is sorting up to 5 levels I use this on block attributes to do quantities,
So ( x y z entityname)( x y z entityname)( x y z entityname) just sort on 3 items, then use a remove duplicates comparing the "item" with "next item".
The code below is provided on a as is basis and up to end user to check its suitability for the task.
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/create-a-new-list-from-an-existing-list/td-p/11475501
;
(defun remdupblks ( / ss ss2 lst ent pt x y z entname k ans ans2 )
(defun compare-elements (a b sortspec)
( (lambda (x y test)
(if (and (equal x y ) (cdr sortspec))
(compare-elements a b (cdr sortspec))
(apply test (list x y))
)
)
(nth (cdar sortspec) a)
(nth (cdar sortspec) b)
(caar sortspec)
)
)
(defun complex-sort (alst sortspec)
(vl-sort alst
'(lambda (a b)
(compare-elements a b sortspec)
)
)
)
(prompt "\nSelect blocks ")
(setq ss (ssget '((0 . "INSERT"))))
(setq lst '())
(repeat (setq j (sslength ss))
(setq ent (entget (ssname ss (setq j (1- j)))))
(setq pt (cdr (assoc 10 ent)))
(setq x (car pt) Y (cadr pt) Z (caddr pt))
(setq entname (cdr (assoc -1 ent)))
(setq lst (cons (list x y z entname) lst))
)
(setq lst (complex-sort lst '((< . 0) (< . 1) (< . 2))))
(setq ss2 (ssadd))
(setq x 0)
(setq ans (nth x lst))
(repeat (- (length lst) 1)
(setq ans2 (nth (1+ x) lst))
(if (and
(= (nth 0 ans)(nth 0 ans2))
(= (nth 1 ans)(nth 1 ans2))
(= (nth 2 ans)(nth 2 ans2))
)
(setq ss2 (ssadd (nth 3 ans2) ss2))
)
(setq ans ans2)
(setq x (1+ x))
)
(command "erase" ss2 "")
(alert (strcat (rtos (sslength ss) 2 0) " blocks selected " (rtos (sslength ss2) 2 0) " blocks removed "))
(princ)
)
(remdupblks)
Anybody else what numbers did you end up with for BD dwg ?
