Great one Gile, here is the translation:
Although I could not find a translation for Aucne
;; http://www.theswamp.org/index.php?topic=14347.msg173186#msg173186
;; By Gile 01.09.2007
;;; Nested_coord Turns over a list whose each element is of the type:
;;; (Name_of_parent Coordinates_l' child_in_the_parent)
;;;
;;; The argument is the name of the block which one seeks the co-ordinates in
;;; blocks in lequels it is overlapping (some is the level of overlap).
;;;
;;; The execution of the LISP can take a little time if the collection is provided.
(defun nested_coord (enfant / temp_lst parent ent final_lst)
;; Initially, the list consists of only one element:
;; the name of the block child and co-ordinates of his basic point.
(setq temp_lst
(cons
(cons enfant (cdr (assoc 10 (tblsearch "BLOCK" enfant))))
temp_lst
)
)
;; One buckles on each element of the list to seek in each block of the table
;; if the block forms part of its components. If it is the case, the block relative is added
;; at the end of the list and will be treated in its turn.
(while temp_lst
(setq parent (tblnext "BLOCK" t))
(while parent
(setq ent (cdr (assoc -2 parent)))
(while ent
(if (and (= (cdr (assoc 0 (entget ent))) "INSERT")
(= (cdr (assoc 2 (entget ent))) (caar temp_lst))
)
;; Addition of the new block "relative" at the end of the list
;; Addition of the co-ordinates of the insertion point of the block child in
;; block relative and of the co-ordinates associated with the block child
(setq temp_lst
(reverse
(cons
(cons
(cdr (assoc 2 parent))
(mapcar '+
(cdr (assoc 10 (entget ent)))
(cdar temp_lst)
)
)
(reverse temp_lst)
)
)
)
)
(setq ent (entnext ent))
)
(setq parent (tblnext "BLOCK"))
)
(setq final_lst (cons (car temp_lst) final_lst)
temp_lst (cdr temp_lst)
)
)
;; Removal of the element "child" of the list
(reverse (cdr (reverse final_lst)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:test (/ nest ss n ref r_lst n_lst)
(setq nest "")
(while (not (tblsearch "Block" nest))
(setq nest (getstring "\nEnter the name of the required block: "))
)
(if (setq ss (ssget "_A" '((0 . "INSERT"))))
(repeat (setq n (sslength ss))
(setq ref (ssname ss (setq n (1- n)))
r_lst (entget ref)
n_lst (nested_coord nest)
)
(if (assoc (cdr (assoc 2 r_lst)) n_lst)
(progn
(setq
c_lst (mapcar
'cdr
(vl-remove-if-not
'(lambda (x) (= (car x) (cdr (assoc 2 r_lst))))
n_lst
)
)
c_lst (mapcar '(lambda (x)
(setq x (list
(* (car x) (cdr (assoc 41 r_lst)))
(* (cadr x) (cdr (assoc 42 r_lst)))
(* (caddr x) (cdr (assoc 43 r_lst)))
)
x (polar '(0 0 0)
(+ (angle '(0 0 0) x)
(cdr (assoc 50 r_lst))
)
(distance '(0 0 0) x)
)
x (trans (mapcar '+
(cdr (assoc 10 r_lst))
x
)
ref
1
)
)
)
c_lst
)
)
(princ (strcat "\nThe block \""
nest
"\" embeded in \""
(cdr (assoc 2 r_lst))
"\" is inserted in : "
)
)
(mapcar 'print c_lst)
)
(prompt (strcat "\nAucne overlap of the block \""
nest
"\" in the block \""
(cdr (assoc 2 r_lst))
"\"."
)
)
)
)
)
(textscr)
(princ)
)