I modified BlockInfo.Lsp by Alan (CAB) to find insertion points of nested blocks, but the results I got are definition of insertion blocks.
My question is how can I get the real world coordinates of insertion points of this nested blocks?
I know I have to utilize some kind coordinates transformation, can you give me a pointer for coordinates transformation especially for rotated blocks?
Any help is greatly appreciated. Thanks.
EDIT I: I used Refgeom (Gile) function as advised by Lee Mac, but I don't know how to apply the Transformation matrix.
EDIT II: PROBLEM SOLVED
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
;;; FUNCTION BlockInfo.lsp
;;; Send a block definition to text file "Block Data-[block name].txt"
;;; You should view text file with word wrap off because
;;; some of the lined are very long
;;;
;;; ARGUMENTS
;;; none
;;;
;;; USAGE
;;; BlockInfo
;;;
;;; PLATFORMS
;;; 2000+
;;;
;;; AUTHOR
;;; Copyright© 2004 Charles Alan Butler
;;; ab2draft@TampaBay.rr.com
;;;
;;; VERSION
;;; 1.1 Sep. 23, 2004
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
;;;
;;; This routine may be used and copied for non-profit
;;; purposes only. If you wish to include any of the file in a
;;; commercial program, contact the author.
;;;
(defun c:BlockInfo (/
bname dxf data indent fname fn blkcnt indent
)
;; extract the data from dotted pair
(defun dxf (x) (cdr (assoc x data)))
(if (setq bname (entsel "Pick a block: "))
(if (and (setq data (entget (car bname)))
(or (= "INSERT" (dxf 0))
(= "DIMENSION" (dxf 0))
)
) ;and
(progn
(setq parent_enm (car bname))
(setq bname (dxf 2))
);end progn
(setq bname nil)
) ;if
(if (and
(setq bname (getstring t "\nEnter the block name: "))
(setq ss (ssget "_X" (list '(0 . "INSERT")(cons 2 bname))))
(setq ename (ssname ss 0)))
(princ); got a block
(setq bname nil); GETNAME FAILED
); if
) ;if
(cond
(bname
(setq Fname (Strcat "Block Data-" bname ".txt"))
(setq fn (open fname "w"))
(prt "===============================================")
(prt " BlockInfo.lsp")
(prt " Charles Alan Butler")
(prt " ab2draft@TampaBay.rr.com")
(prt " 09/23/2004 Ver 1.1")
(prt "===============================================")
;; Create current Date & Time
(setq tmp (rtos (getvar 'cdate) 2 4))
(setq tmp (strcat " << File Date "
(substr tmp 5 2) "/" (substr tmp 7 2) "/"
(substr tmp 1 4) "@" (substr tmp 10 2) ":"
(substr tmp 12 2) " >>"
)
)
(prt tmp)
(setq blkcnt 0
indent "| "
)
(listb bname)
(prt "*********** END OF PARENT BLOCK *************")
(setq indent nil)
(prt "===============================================")
(prt "= End of Routine =")
(prt "===============================================")
(close fn)
(prompt (strcat "\nBlock data written to file: " fname))
)
(t (print " no block found."))
) ;cond
(princ)
)
;;--------------------------------------
;; do the actual line print to file
(defun prt (txt)
(if indent
(princ indent fn)
)
(princ txt fn)
(write-line "" fn)
)
;;--------------------------------------
;; This sub routine does all the work
(defun listb (bname / dxf data wait)
;; return value from a dotted pair
(defun dxf (x) (cdr (assoc x data)))
;; begin the main program
(if (= blkcnt 0)
(setq header (strcat " Parent Block : " bname))
(setq header (strcat " Sub Block "
(itoa blkcnt); number of nested levels
" : "
bname
)
)
)
(prt "***********************************************")
(prt header)
(prt "***********************************************")
(prt (setq data (entget(tblobjname "block" bname))))
(prt "--------- Objects In Block ----------------")
(setq data (dxf -2)) ; get first entity
(prt (setq data (entget data '("*")))) ; get assoc list
(while data
(if (= (dxf 0) "INSERT")
(progn
(setq blkcnt (1+ blkcnt)
indent (strcat indent "| ")
)
(if (= (cdr (assoc 2 data)) "DRIVINGPILE")
(progn
(princ "\n. DXF-CODE 10 = ")
(princ (cdr (assoc 10 data)))
(princ "\t is not an insertion point of nested block")
;; Lee Mac said, I need to use RefGeom (gile), but how?
(setq Transmatrix_point (refgeom (cdr (assoc -1 data))))
(princ "\n. Transformation data: ")
(princ Transmatrix_point)
(setq ipt (trans (cdr (assoc 10 data)) (cdr (assoc 210 data)) 0))
(entmake
(list
'(0 . "POINT")
(cons 10 (apply '(lambda ( m v ) (mapcar '+ (mxv m ipt) v)) (refgeom (cdr (assoc -1 (entget parent_enm))))))
)
)
);end progn
);end if
(listb (dxf 2))
(setq indent (substr indent 3))
(prt "************ END OF SUB BLOCK **************")
)
)
(if (setq data (entnext (dxf -1)))
(progn
(prt (setq data (entget data '("*")))) ; get assoc list
);end progn
);end if
) ;while
(princ)
)
(prompt "\nBlock Info Loaded, Enter BlockInfo to run.")
(princ)
;;;--- end of file -----------------------------------------
;; RefGeom (gile)
;; Returns a list whose first item is a 3x3 transformation matrix and
;; second item the object insertion point in its parent (xref, block or space)
(defun refgeom ( ent / ang enx mat ocs )
(setq enx (entget ent)
ang (cdr (assoc 050 enx))
ocs (cdr (assoc 210 enx))
)
(list
(setq mat
(mxm
(mapcar '(lambda ( v ) (trans v 0 ocs 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 enx)) 0.0 0.0)
(list 0.0 (cdr (assoc 42 enx)) 0.0)
(list 0.0 0.0 (cdr (assoc 43 enx)))
)
)
)
)
(mapcar '- (trans (cdr (assoc 10 enx)) ocs 0)
(mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx))))))
)
)
)
;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix
(defun trp ( m )
(apply 'mapcar (cons 'list m))
)
;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices
(defun mxm ( m n )
((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
