TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Andrea on January 07, 2007, 07:57:26 PM
-
Hi all,..
We have many block inside block inside block..
But i need to get insertion point of specific block...
there is my code.
(setq ins (cdr (assoc 10 (tblsearch "BLOCK" "HQZP1"))))
If the block itself is not present in current drawing...
the (ssget.... command can't see to find it.
any suggestion ?
-
I don't really understand the question either... :?
-
If i understand, with this ?
(setq ins (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) "HQZP1"))
(vlax-get ins 'origin)
@+
-
Ah yes, it's exact i'm not awaked yet this morning ;-)
According to which I understand, Andrea seeks the block of insertion of a block include in another
@+
-
Here's something by Luis which should help, if I understand the question.
I saved it because it's interesting how he does it. Hi Luis. :-)
;; -------------------------------
;; by Luis posted 10/31/2005
(defun draw_point (pt col / d)
(setq d (* (getvar "viewsize") 0.015))
(grdraw
(trans (polar pt (* 0.25 pi) d) 0 1)
(trans (polar pt (* 1.25 pi) d) 0 1)
col
(- col))
(grdraw
(trans (polar pt (* 0.75 pi) d) 0 1)
(trans (polar pt (* 1.75 pi) d) 0 1)
col
(- col)))
;; get nested block insertion point
(defun C:NESTIP (/ ndata)
(if (and (setq ndata (nentsel)) (> (length ndata) 2))
(draw_point (last (caddr ndata)) 7))
(princ))
;; -------------------------------
-
Great,
but your lisp work only for one level of nested block
@+
-
Oh, it's not necessary to be sorry. Me the first i'm far from thinking of all. 8-)
But you are right, wait to have an answer to our questions.
@+
-
....
there is my code.
(setq ins (cdr (assoc 10 (tblsearch "BLOCK" "HQZP1"))))....
Andrea, please explain exactly what you think this code does.
this should be retreive dxf code of insertion block point.
but it always 0,0,0.....i don't understand why.
-
It's always 0,0,0 because you are looking at the block definition, rather than a block reference/insert.
Try the code I posted by Luis.
-
Hola Joe,
Glad you are here Sir!
Andrea;
In Italian:
Trasmettere la vostra domanda sulla vostra propria lingua.
In French
Transmettre votre question dans votre propre langue.
LE....thanks.
French:
J'essai d'obtenir le point d'insertion d'un block contenu dans un block.
cependant, je n'arrive pas à savoir comment y parvenir car l'orsque j'extrait les données
des entitées les code DXF me reviens toujour à 0,0,0 et je ne comprend pas le pourquoi.
Italian:
il mio francese è un po migliore che mia lingua natale.
-
Go here and test the routine, it does what you want.
http://www.theswamp.org/index.php?topic=14347.msg172782#msg172782
Have fun.
lol....
Thanks LE...I saw the Joe routine..and I put on my example list. thanks Joe.
but, (nentsel ...allow user to select the block....and than capture the nested entity..
but I need to know how to select this block without user intervention.
to extract entity data.
-
See there (http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=11074#pid43541).
Hope you are a member ! (it is necessary if you want to see some answers (they are brilliant)).
En +, c'est en Français, dingue non ?
http://www.hyperpics.com/customization/autolisp/
At hyperpics, it used to be a great routine called return-nested but they've just changed the website and I can't find it any more. Too bad 'cause it was just for you.
-
With this ?
(defun c:rin(/ bls pt ins)
(defun pts (bl)
(vlax-for ent bl
(if (eq (vla-get-ObjectName ent) "AcDbBlockReference")
(progn
(princ (strcat "\nSous bloc --> " (vla-get-name ent) " --> Point d'insertion --> "))
(princ (mapcar '+ (trans pt 1 0) (vlax-get ent 'InsertionPoint)))
(pts (vla-item bls (vla-get-name ent)))
)
)
)
)
(setq sel (entget (car (entsel))) bls (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
(princ (strcat "\nBloc maitre --> " (cdr (assoc 2 sel))" --> Point d'insertion --> "))
(princ (trans (setq pt (cdr (assoc 10 sel))) 1 0))
(pts (vla-item bls (cdr (assoc 2 sel))))
(princ)
)
You can update the lisp and do a vlax-for in the blocks table
@+
-
Thanks...interesting..
but in fact, I think is not easier that we think..
We have block Y in Block X
So I think like this...
1) found the babyBlock Y
2) retreive the name of the motherBlock X
3) extract all information of the motherBlock X to retreive the coordinate of the BabyBlock Y
This fonction do not required any selection....just filter.
Is this what I need to do ? can be done like that ?
-
This will not work on a scaled, rotated, mirrored, uniform block
You tested it?. it's work with any block insert on drawing (scaled, rotated, mirrored, uniform block)
@+
-
This will not work on a scaled, rotated, mirrored, uniform block
You tested it?. it's work with any block insert on drawing (scaled, rotated, mirrored, uniform block)
I just tested it, Luis is correct, it does not work correctly.
... and I am quietly laughing because Andrea still hasn't stated what he wants :?
-
I don't understand. It's work for me ? :?
I try with this drawing
@+
-
Hi,
I answered to the same question here (http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=13321#pid52560), in French, in the web site Call me Bert told.
Serais-tu CADy sur Cadxp ?
Here's the code :
;;; Nested_coord Retourne une liste dont chaque élément est du type :
;;; (Nom_du_parent Coordonnées_l'enfant_dans_le_parent)
;;;
;;; L'argument est le nom du bloc dont on recherche les coordonnées dans les
;;; blocs dans lequels il est imbriqué (quelque soit le niveau d'imbrication).
;;;
;;; L'exécution du LISP peut prendre un peu de temps si la collection est fournie.
(defun nested_coord (enfant / temp_lst parent ent final_lst)
;; Dans un premier temps, la liste est constituée d'un seul élément :
;; le nom du bloc enfant et les coordonnées de son point de base.
(setq temp_lst
(cons
(cons enfant (cdr (assoc 10 (tblsearch "BLOCK" enfant))))
temp_lst
)
)
;; On boucle sur chaque élément de la liste pour chercher dans chaque bloc de la table
;; si le bloc fait partie de ses composants. Si c'est le cas, le bloc parent est ajouté
;; en fin de liste et sera traité à son tour.
(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))
)
;; Ajout du nouveau bloc "parent" en fin de liste
;; Addition des coordonnées du point d'insertion du bloc enfant dans le
;; bloc parent et des coordonnées associées au bloc enfant
(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)
)
)
;; Suppression de l'élément "enfant" de la liste
(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 "\nEntrez le nom du bloc recherché: "))
)
(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 "\nLe bloc \"" nest "\" imbriqué dans \"" (cdr (assoc 2 r_lst)) "\" est inséré en : "))
(mapcar 'print c_lst)
)
(prompt (strcat "\nAucune imbrication du bloc \""
nest
"\" dans le bloc \""
(cdr (assoc 2 r_lst))
"\"."
)
)
)
)
)
(textscr)
(princ)
)
-
Et oui, c'est le même ^-^
It's more easy to speak french :roll:
@+
-
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)
)
-
Although I could not find a translation for Aucne
There's none :lol:
Because the good spelling is "aucune" and it means "none" :evil: (aucun or aucune, male or female)
-
male or female
Leave it to the French to have male & female versions of words. :-D
-
Ouf...!
Exactly what i'm looking for...
What I like when looking in some code....is the explaination
that help me a lot.
Thanks you very much all.
(Oui je suis CADy sur l'autre site car j'ai pas pu m'enregistrer sur AndreaLISP)
One day guys...I promise to surprise you..
Thanks again....and have a good day !
-
Leave it to the French to have male & female versions of words. :-D
Let's play a game :
CAB, do you beleive that AutoCAD is a male or a female ?
(Italian, German and Spanish people can play 'cause they don't give the same gender to things as their european neighbours, but I prefer english and american people to play the game)
-
I have never given Acad a gender, or thought of it with a gender. But my car is a female. :-D
-
Let's play a game :
CAB, do you believe that AutoCAD is a male or a female ?
[tongue in cheek ]
Anything that temperamental has go to be a woman.
[/tongue in cheek ]
-
Let's play a game :
CAB, do you believe that AutoCAD is a male or a female ?
[tongue in cheek ]
Anything that temperamental has go to be a woman.
[/tongue in cheek ]
:-D :-D What he said
-
German people have a neutral gender and they probably use it for Acad.
But Acad is definitly a male in French, even if it is costly, some would say expensive which better applies to women (experienced) :kewl:
A DWG is a male
a script is a male
a program is a male
an arc is a male
a line is a female
a dimension is a female
a poyline is a female as well as a spline
......