TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: csgoh on March 31, 2008, 05:08:00 AM
-
I am not familiar with blocks and i hope tp get some help.
How to get the coordinates of the subentities in a block.
i dont mean the insertion point of the block.
asssuming a block has 3 POINTs, a TEXT and a LINE entity. How to extract the coordinates of the 3 POINTS, the insertion point of the TEXT, the start and end point of the line in relation to the WCS.
thanks
csgoh
-
The block itself has the relationship of all the subentities to the insertionpoint.
Applying a matrix to the coordinates of the subentity (the matrix is a combo of the translation reqd. to get to the blockref insertion point , the rotation of the block and the block normal) will give you the point reqd.
-
Hi,
I'm going to try to explain the way I do in spite of my poor English.
First, get the entity using nentsel
nentsel returns a list wich:
1st item is the object ename
2nd item the pick point coordinates (UCS)
3rd item a 4X3 transformation matrix
4th item a list of references enames from the most nested (the entity owner) to the less one.
(setq ent (nentsel))
(setq ename (car ent)) ;ename of nested selected entity
(setq owner (car (last ent))) ;ename of the entity owner
(setq mat (reverse (cdr (reverse (caddr ent))))) ; 3X3 tranformation matrix
(setq ins (last (caddr ent))) ; insertion point of the owner
(setq coord (cdr (assoc 10 (entget ename)))) ; entity coordinates in its owner definition
The transformation matrix returned by nentsel can be splited in a 3X3 rotation and scaling matrix and a displacement vector (matrix last row).
The 3X3 matrix corresponds to the transformation from the reference insertion (including rotations and X,Y,Z scalings) to the block definition.
The vector corresponds to the displacement from WCS origin to the insertion point of the owner of selected entity.
So, we can transform the "original" entity coordinates to its "transformed" coordinates in the reference by applaying them the transposed 3X3 matrix and and displace ithem with the displacement vector.
To do this I use 2 little routines mxv and trp.
;; transpose une matrice by Doug Wilson
(defun trp (m)
(apply 'mapcar (cons 'list m))
)
;; Apply a transformation matrix to a vector by Vladimir Nesterovsky
(defun mxv (m v)
(mapcar (function (lambda (r) (vxv r v))) m)
)
(setq WCScoord (mapcar '+ ins (mxv (trp mat) coord)))
Hope it helps.
-
Thanks Gile.
Here is an old thread too.
http://www.theswamp.org/index.php?topic=14347.msg173186#msg173186
-
You can also find, here (http://www.theswamp.org/index.php?topic=3836.msg163713#msg163713) a routine (RCS2WCS) which do the same job:
(setq ent (nentsel))
(setq WCScoord (rcs2wcs (cdr (assoc 10 (entget (car ent)))) (caddr ent)))
-
thanks guys.
will try it out.
-
codes as suggested by link from gile
;;; VXV Returns the dot product of 2 vectors
(defun vxv (v1 v2)
(apply '+ (mapcar '* v1 v2))
)
;;; VLEN Returns the length of a vector
(defun vlen (v)
(sqrt (vxv v v))
)
;;; VUNIT Returns the single unit vector of a vector
(defun vunit (v / l)
(if (/= 0 (setq l (vlen v)))
(mapcar '(lambda (x) (/ x l)) v)
)
)
;; transpose a matrix Doug Wilson
(defun trp (m)
(apply 'mapcar (cons 'list m))
)
;; Apply a transformation matrix to a vector by Vladimir Nesterovsky
(defun mxv (m v)
(mapcar '(lambda (r) (vxv r v)) m)
)
;; Multiply two matrices by Vladimir Nesterovsky
(defun mxm (m q)
(mapcar '(lambda (r) (mxv (trp q) r)) m)
)
;; translates coordinates from Reference (block or xref) Coordinate System to WCS
;; Arguments :
;; pt : a point in RCS, got by (cdr (assoc 10 (entget (car (nentsel))))) i.e.
;; mat : a transformation matrix as those returned either by (nentsel) or (nentselp)
(defun RCS2WCS (pt mat)
(if (= 3 (length (car mat)))
(mapcar '+ (mxv (trp (butlast mat)) pt) (last mat))
(mapcar '+
(mxv (mapcar 'butlast (butlast mat)) pt)
(butlast (mapcar 'last mat))
)
)
)
;; translates coordinates from WCS to Reference (block or xref) Coordinate System
(defun WCS2RCS (pt mat / rs_mat tr_vec)
(if (= 3 (length (car mat)))
;; nentsel matrix
(setq rs_mat (butlast mat) ; scale/rotation matrix
tr_vec (last mat) ; translation vector
)
;; nentselp matrix
(setq rs_mat (trp (mapcar 'butlast (butlast mat))) ; scale/rotation matrix
tr_vec (butlast (mapcar 'last mat)) ; translation vector
)
)
(mxv
(mxm (mapcar '(lambda (v) (mapcar '/ v (mapcar 'vlen rs_mat)))
'((1 0 0) (0 1 0) (0 0 1))
)
(mapcar 'vunit rs_mat)
)
(mapcar '- pt tr_vec)
)
)
couldn't find the function butlast?
where can i get it.
-
Oopss !
(defun butlast (lst) (reverse (cdr (reverse lst))))
-
thanks gile
-
Need help. Where have i gone wrong with my lisp? Function returns wrong coordinates for those neted blocks?
(defun c:bit ( / AllCoords-List WCSCoord)
(defun wg:dxf (code ename)
(cdr (assoc code (entget ename)))
); wg:dxf
;---------------------------------
(defun SSNttList (ss / n l)
(repeat (setq n (sslength ss))
(setq l (cons (ssname ss (setq n (1- n))) l))
)
)
;---------------------------------
;;; VXV Returns the dot product of 2 vectors
(defun vxv (v1 v2)
(apply '+ (mapcar '* v1 v2))
)
;;; VLEN Returns the length of a vector
(defun vlen (v)
(sqrt (vxv v v))
)
;;; VUNIT Returns the single unit vector of a vector
(defun vunit (v / l)
(if (/= 0 (setq l (vlen v)))
(mapcar '(lambda (x) (/ x l)) v)
)
)
;; transpose a matrix Doug Wilson
(defun trp (m)
(apply 'mapcar (cons 'list m))
)
;; Apply a transformation matrix to a vector by Vladimir Nesterovsky
(defun mxv (m v)
(mapcar '(lambda (r) (vxv r v)) m)
)
;; Multiply two matrices by Vladimir Nesterovsky
(defun mxm (m q)
(mapcar '(lambda (r) (mxv (trp q) r)) m)
)
(defun butlast (lst)
(reverse (cdr (reverse lst)))
)
;; translates coordinates from Reference (block or xref) Coordinate System to ;;WCS
;; Arguments :
;; pt : a point in RCS, got by (cdr (assoc 10 (entget (car (nentsel))))) i.e.
;; mat : a transformation matrix as those returned either by (nentsel) or ;(nentselp)
(defun RCS2WCS (pt mat)
(if (= 3 (length (car mat)))
(mapcar '+ (mxv (trp (butlast mat)) pt) (last mat))
(mapcar '+
(mxv (mapcar 'butlast (butlast mat)) pt)
(butlast (mapcar 'last mat))
)
)
)
;-------------------------------------
(prompt "\nSelect BLOCK objects ")
(if (and (setq SS (ssget '((0 . "INSERT"))))
(setq SS (SSNttList SS))
)
(progn
(foreach BLK SS
(setq ent (nentselp (wg:dxf 10 BLK)))
(setq mat (reverse (cdr (reverse (caddr ent))))) ; 3x3 transformation matrix
(setq AllCoords-List '())
(setq bname (wg:dxf 2 BLK))
(wg:ListBLK bname)
(print "allcoords-List ")(princ allcoords-list)
(setq WCScoord (mapcar '(lambda (x) (rcs2wcs x (caddr ent))) AllCoords-List))
(print "wcscoord ")(princ wcscoord)
);foreach
)
);if
(princ)
)
;;
;; Routine extracted from BLOCKINFO by
;; ;;; AUTHOR
;;; Copyright© 2004 Charles Alan Butler
;;; ab2draft@TampaBay.rr.com
;;
(defun wg:ListBLK ( bname / BLKNtt NextNtt ent)
(setq BLKNtt (tblobjname "block" bname))
(setq NextNtt (wg:dxf -2 BLKNtt))
(print "nextntt ")(princ (entget nextntt))
(while NextNtt
(if (eq (wg:dxf 0 NextNtt) "INSERT") ; other nested block
(progn
(wg:LISTBLK (wg:dxf 2 NextNtt))
)
);if
(if (setq NextNtt (entnext (wg:dxf -1 NextNtt)))
(cond
((eq (wg:dxf 0 NextNtt) "POINT")
(setq AllCoords-List (cons (wg:dxf 10 NextNtt) AllCoords-List ))
);POINT entity
);cond
);if
);while
);wg:ListBLK
thanks in advance
-
Hi,
I cannot understand what you want to do.
wg:ListBLK get coords from the block definition, rcs2wcs is to be used with the coords of an entity in an inserted reference.
Try this little routine on the file you posted.
(defun c:test (/ os ent pt)
(setq os (getvar "OSMODE"))
(setvar "OSMODE" 73)
;; get a point
(setq
pt (getpoint
"\nPick on a point, a text insertion point or a line start point: "
)
)
;; get the nested entity
(setq ent (nentsel "\nSelect the nested entity: "))
;; compare coordinates
(alert
(strcat
"Picked point:\t"
(vl-princ-to-string (trans pt 1 0))
"\nRCS2WCS return:\t"
(vl-princ-to-string
(rcs2wcs (cdr (assoc 10 (entget (car ent)))) (caddr ent))
)
)
)
(setvar "OSMODE" 73)
(princ)
)[code][/code]
-
sorry for the confusion. Like i said i am no good at blocks.
what i am trying is to get all the wcs coordinates of points, endpoint of lines , text iinsertion pt in a block.
gile, the code you posted is for each selection one at a time.
what about if i select all the blocks at one go, then i need to iterate in order to find what the entities are in the blocks. this is the area where i need help.
-
sorry for the confusion. Like i said i am no good at blocks.
what i am trying is to get all the wcs coordinates of points, endpoint of lines , text iinsertion pt in a block.
gile, the code you posted is for each selection one at a time.
what about if i select all the blocks at one go, then i need to iterate in order to find what the entities are in the blocks. this is the area where i need help.
AFAIK, there is no way to do what you are asking for.
-
so, any alternative or workaround.
-
so, any alternative or workaround.
Maybe if you tell us what the finished product would be, then maybe someone knows of a way to do what you want to do.
-
i need to calculate of the coordinates of point, insertion pt of text, end points of lines,lwpolylines that exist in a block. The block may just consist of points only or may contain nested blocks. the final result is to get the coordinates of each each entity. attached dwg is the final result that i require.
I have revised my codes and if it only returns the coordinates of those entities not nested and I need help for those nested blocks within the block.
(defun c:testr ( / nextntt nttlist insertlist ename AllCoords-List)
(if (setq ref (entsel "\nSelect a block "))
(progn
;; http://www.theswamp.org/index.php?topic=14347.msg173186#msg173186
;; By Gile 01.09.2007
(setq ref (car ref)
r_lst (entget ref)
y1 (cdr (assoc 41 r_lst))
y2 (cdr (assoc 42 r_lst))
y3 (cdr (assoc 43 r_lst))
y4 (cdr (assoc 50 r_lst))
y5 (cdr (assoc 10 r_lst))
)
(setq nextntt (tblobjname "block" (cdr (assoc 2 r_lst))))
(setq nttlist '())
(setq insertlist '())
(while (setq nextntt (entnext nextntt))
(if (eq "INSERT" (cdr (assoc 0 (entget nextntt))))
(setq insertlist (cons nextntt insertlist))
(setq nttlist (cons nextntt nttlist))
);if
)
)
);if
(setq AllCoords-List '())
(foreach ntt nttlist
(cond
((eq "POINT" (setq ename (cdr (assoc 0 (entget ntt)))))
(setq AllCoords-List (append
(transT (list (cdr (assoc 10 (entget ntt)))))
AllCoords-List))
);POINT
((eq "LINE" (setq ename (cdr (assoc 0 (entget ntt)))))
(setq AllCoords-List (append
(transT (list (cdr (assoc 10 (entget ntt)))))
AllCoords-List))
(setq AllCoords-List (append
(transT (list (cdr (assoc 11 (entget ntt)))))
AllCoords-List))
);LINE
);cond
);foreach
(print "allcoords-list ")(princ allcoords-list)
);testr
Hope i have explained in detail what i require.
thanks
-
forgot the dwg file.
-
Where you want the coords to be , in a FILE??
-
in a list,pls
-
can it solve your's problem???
-
sorry devitg, i could not open your dwg file as i am using map2004 win xp. can you downgrade it pls.
but looking into the xls file, the coordinates do not seem to be correct. what i need are those coordinates as shown in the dwg i posted. and if possible, i need a function whereby it will return all the coords is a list.
thanks.
-
Hi Csogh , I thought it can be solved via the eattext command , but it seem it is not possible.
Really I can not wonder how if the point is really a such place the eattext gives others points .
-
devitg, thanks for your help anyway.
any more suggestions?
-
sorry , no more.
-
anyone else to help?
-
did you get my private message??
-
anyone else to help?
I'm looking into a solution today but work is in the way.
I'll let you know where I'm at the end of the day.
-
I'm trying to do something too, but wait a moment, please...
-
OK, rude & Crude but worked on you sample.
No support to non WCS.
Perhaps gile will have that handled. 8-)
-
Here's one.
It seems to work
;; Entmatrix
;; Returns a list which first item is the 3X3 tranformation matrix and second item
;; the insertion point of a block refernce in its owner (space or block definition)
(defun EntMatrix (ename / elst ang norm)
(setq elst (entget ename)
ang (cdr (assoc 50 elst))
norm (cdr (assoc 210 elst))
)
(list
(mxm
(mapcar (function (lambda (v) (trans v 0 norm T)))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
(mxm
(list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(list (list (cdr (assoc 41 elst)) 0.0 0.0)
(list 0.0 (cdr (assoc 42 elst)) 0.0)
(list 0.0 0.0 (cdr (assoc 43 elst)))
)
)
)
(trans (cdr (assoc 10 elst)) norm 0)
)
)
;; Blk2Coord
;; Returns a list of a block reference entities coordinates
(defun Blk2Coord (ref mat ins / blk ent lst)
(setq blk (tblsearch "BLOCK" (cdr (assoc 2 (entget ref)))))
(setq ent (cdr (assoc -2 blk)))
(while ent
(setq elst (entget ent)
typ (cdr (assoc 0 elst))
)
(cond
((= "LINE" typ)
(setq lst (cons (list typ
(mapcar '+ ins (mxv mat (cdr (assoc 10 elst))))
(mapcar '+ ins (mxv mat (cdr (assoc 11 elst))))
)
lst
)
)
)
((member typ '("POINT" "TEXT"))
(setq lst (cons (list typ
(mapcar '+ ins (mxv mat (cdr (assoc 10 elst))))
)
lst
)
)
)
((= "INSERT" typ)
(setq nent (EntMatrix ent))
(setq lst
(append
lst
(Blk2Coord ent
(mxm mat (car nent))
(mapcar '+ ins (mxv mat (cadr nent)))
)
)
)
)
(T nil)
)
(setq ent (entnext ent))
)
(cons (list (cdr (assoc 2 blk)) ins) lst)
)
;; Transpose a matrix Doug Wilson
(defun trp (m)
(apply 'mapcar (cons 'list m))
)
;; Apply a transformation matrix to a vector by Vladimir Nesterovsky
(defun mxv (m v)
(mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
m
)
)
;; Multiply two matrices by Vladimir Nesterovsky
(defun mxm (m q)
(mapcar (function (lambda (r) (mxv (trp q) r))) m)
)
;; Main function
(defun c:test (/ ss n ent mtx lst)
(if (setq ss (ssget '((0 . "INSERT"))))
(repeat (setq n (sslength ss))
(setq ent (ssname ss (setq n (1- n)))
mtx (EntMatrix ent)
lst (append (Blk2Coord ent (car mtx) (cadr mtx)) lst)
)
)
)
(mapcar 'print lst)
(textscr)
(princ)
)
-
gile,
I must say that's a very nice solution.
-
thanks gile, cab.
-
csgoh,
you're welcome.
CAB,
thanks, the way you return the results is very nice too.
-
Hi,
Here's a new version with an easier reading display in the text screen.
i.e. selecting all blocks in csgoh's sample file:
Commande: test
Choix des objets: Spécifiez le coin opposé: 4 trouvé(s)
Choix des objets:
- "1"
- POINT(264.6 122.06 0.0)
- POINT(253.143 132.313 0.0)
- "1"
- POINT(286.612 139.888 0.0)
- POINT(286.122 124.52 0.0)
- "2"
- LINE(334.632 153.619 0.0)(347.486 167.068 0.0)
- "1"
- POINT(344.621 171.17 0.0)
- POINT(330.822 164.388 0.0)
- "3"
- "1"
- POINT(429.48 175.365 0.0)
- POINT(415.723 182.232 0.0)
- "2"
- LINE(403.789 189.773 0.0)(422.277 187.698 0.0)
- "1"
- POINT(423.804 192.463 0.0)
- POINT(410.047 199.33 0.0)
((264.6 122.06 0.0) (253.143 132.313 0.0))
((286.612 139.888 0.0) (286.122 124.52 0.0))
((334.632 153.619 0.0) (347.486 167.068 0.0) (344.621 171.17 0.0) (330.822 164.388 0.0))
((429.48 175.365 0.0) (415.723 182.232 0.0) (403.789 189.773 0.0) (422.277 187.698 0.0) (423.804 192.463 0.0) (410.047 199.33 0.0))