Hello all,
i had modify search code of Gile coordinates of subentities this forum for LWPolyline. In my case block error. Pls tell me where ? Thanks.
;; 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
)
)
)
((= "LWPOLYLINE" typ)
(setq lst
(cons
(list
typ
(mapcar
'(lambda (p) (mapcar '+ ins (mxv mat p)))
(mapcar '(lambda (aa) (append aa (list 0.)))
(mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) 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)
)
