Legend AutoLisp

Byvomark

(defun C:LEGEND ()

(prompt “\nBuilding legend list…\n”)
;Set variable to get the first element of table.
(setq Frst T)
(setq Counter 0)
(setq CountBlk 0)

;Get all block names.
(while (setq Tbdata (tblnext “BLOCK” Frst))
(setq Bname (dxf 2 Tbdata))

;print all block names.
(if (/= Bname nil)
;Discard dimension blocks.
(if (/= “*” (substr Bname 1 1))
;Call function.
(FindTag Bname)
);end if
);end if
(setq Frst nil)
);while end
);end defun

(defun FindTag (InBlkName)
;debug line
;(princ (strcat InBlkName “\n”))

;Check for blocks in drawing.
(if (= InBlkName “ITEMTAG”)
(setq CountBlk (+ CountBlk 1))
;else
(progn
;Call function to get nested blocks.
(setq Blklist (blist InBlkName))

;Call function Show Elements.
(ShowElem Blklist)
);end progn
);end if
);end defun

(defun ShowElem (ElemList)
(foreach ChkEnt Elemlist
(progn
(setq DebugName (dxf 2 ChkEnt))
(if (/= DebugName nil)
(if (= DebugName “ITEMTAG”)
(progn
;Extract Itemtag’s text.
(setq TxtList (GetTagName ChkEnt))
;Print in file.
(CreateFile TxtList)
);end progn
);end if
);end if
);end progn
);end foreach
);end defun

;This function get a text inside a block with attributes.
;Once the ItemTag block has been found look at its sub-entities
;searching for an attrib entity with the data text.

(defun GetTagName (HeadEnt)
;Show head entity.
(setq HeadData (entget (dxf -1 HeadEnt)))

;Get from Head Entity data the first Sub-entity.
(setq PrimCode (entnext (dxf -1 HeadData)))
(setq PrimData (entget PrimCode))
(setq BlkText (dxf 1 PrimData))
(princ (strcat BlkText “\n”))

;Add itemtag text to list.
(setq TagTextList
(append TagTextList
(list BlkText)
);end append
);end setq

;Return a list with text.
TagTextList
);end defun

; DXF returns property of entered code.
(defun dxf (code elist)
(cdr (assoc code elist))
)

; BLIST returns a list of the block head and subentity data
; lists for the specified block name.
(defun blist (blname / tblist tdata ename)
(setq tblist (list (setq tdata (tblsearch “block” blname)))
;set ename to first sub-entity.
ename (dxf -2 tdata)
);end setq
(while
(progn
(setq tblist
(append tblist
(list (entget ename))
);end append
);end setq
(setq ename (entnext ename))
);end progn
);wend
;send back the list.
tblist
);end defun

(defun CreateFile (ListToWrite)
(princ (getvar “Dwgname”))
);end defun

Similar Posts