In a effort to understand block entity structure a little better I
Took some code and came up with this routine that writes a blocks
entity list to a text file. It works with nested blocks and xrefs
as well. I believe it writes the complete entity list of blocks,
entities and sub blocks to the text file.
Please test it for yourself.
Here is the test DWG I used.
Block Test.dwgSuggestions & comments welcome..
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
;;; 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
(setq bname (dxf 2))
(setq bname nil)
) ;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 "===============================================")
(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 (tblsearch "block" bname)))
(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 "| ")
)
(listb (dxf 2))
(setq indent (substr indent 3))
(prt "************ END OF SUB BLOCK **************")
)
)
(if (setq data (entnext (dxf -1)))
(prt (setq data (entget data '("*")))) ; get assoc list
)
) ;while
(princ)
)
(prompt "\nBlock Info Loaded, Enter BlockInfo to run.")
(princ)
;;;--- end of file -----------------------------------------
