Topic: coordinates of subentities

[csgoh]

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.

Code: [Select]

(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

[csgoh]

forgot the dwg file.

[DEVITG]

Where you want the coords to be , in a FILE??

[csgoh]

in a list,pls

[DEVITG]

can  it solve your's problem???

[csgoh]

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.

[DEVITG]

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 .

[csgoh]

devitg, thanks for your help anyway.
any more suggestions?

[DEVITG]

sorry , no more.

[csgoh]

anyone else to help?

[DEVITG]

did you get my private message??

[CAB]

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.

[gile]

I'm trying to do something too, but wait a moment, please...

[CAB]

OK, rude & Crude but worked on you sample.
No support to non WCS.
Perhaps gile will have that handled.

[gile]

Here's one.

It seems to work

Code: [Select]

;; 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)
)