Legend AutoLisp

(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

  • Nine Algorithms That Changed the World

    Nine Algorithms That Changed the World In the realm of computer science, algorithms reign supreme. They are the step-by-step procedures that enable computers to solve problems and make decisions.1 Some algorithms have had such a profound impact on the field that they have become essential tools for programmers and researchers alike. In this article, we…

  • mcrouti3 lisp

    ; If an error (such as CTRL-C) occurs ; while this command is active… (defun at_err (st) (if (and (/= st “Function cancelled”) (/= st “quit / exit abort”)) (princ (strcat “\nError: ” st)) );end if ;Restore modified modes (setvar “regenmode” 1) (setvar “cmdecho” 1) (if (= (type rtfile) ‘FILE) (close rtfile) );end if (setq…

  • How to Fill Orthogonal Polygons with Grid Points in CAD and Geometry

    Problem: There is a closed polygon perimeter. All vertexes are in a right angle (orthogonal) . How to create a grid inside the polygon if it has 8 vertexes? Solution: A simple orthogonal polygon—a polygon where: This problem sits at the intersection of computational geometry, grid rasterization, and polygon point-inclusion tests. ✅ Problem Setup You…

  • MS Access Developer

    Help with design, development or repair of your Microsoft Access database. Some things about me: – 15 years of experience as an independent consultant for Access development projects – Many references. – Masters degree in Biostatistics. – Have taught business development at the Boulder Small Business Development Center. I can wrap my mind around just…

  • vsnap lisp

    (DEFUN C:VSNAP (/) ; Sept. 25,97. By V.Mendez ; This function centers an object between two parallel lines. (SETVAR “CMDECHO” 0) (SETQ SelObj (ENTSEL “\nSelect Object : “)) (SETQ BPoint (GETPOINT “\nBase Point : “)) (COMMAND “OSNAP” “NONE”) (COMMAND “OSNAP” “NEA”) (SETQ Point1 (GETPOINT “\nFirst Point [nearest] : “)) (COMMAND “OSNAP” “PER”) (SETQ Point2 (GETPOINT…