Jump to content
John Green

Block data extract

Recommended Posts

John Green

Hi all

 

I am a fairly basic Lisp user and I am having real issue trying to do something.

 

Using AutoLISP rather than VisualLisp (but if no other way I will use visual lisp)

 

I want t have a routine that will list all blocks on a drawing and return not only block name, but the layer it is on.

 

I have a routine which list all the blocks fine but when I tried adding  (cdr (assoc 8 selblk)) to get layer from dotted pair I just keep getting error that the value is nil

 

I have tried all sorts and spent hours searching internet and cannot find anything that will give me what I want, which is to get for every block on drawing its name and layer (and possible the attribute attached to block, but this isn't vital) I don't want to change anything, just need the information to do some work on it when returned

 

Any help would be most welcome

Share this post


Link to post
Share on other sites
Lee Mac

Here's a relatively simple one:

(defun c:blocklist ( / i l s x )
    (if (setq s (ssget "_X" '((0 . "INSERT"))))
        (progn
            (repeat (setq i (sslength s))
                (setq i (1- i)
                      x (entget (ssname s i))
                      l (LM:nassoc++ (list (LM:name->effectivename (cdr (assoc 2 x))) (cdr (assoc 8 x))) l)
                )
            )
            (princ (strcat "\n" (padright "Block" " " 20) (padright "Layer" " " 20) (padleft "Quantity" " " 8)))
            (foreach x (vl-sort l '(lambda ( a b ) (< (strcase (car a)) (strcase (car b)))))
                (foreach y (vl-sort (cdr x) '(lambda ( a b ) (> (cadr a) (cadr b))))
                    (princ (strcat "\n" (padright (car x) " " 20) (padright (car y) " " 20) (padleft (itoa (cadr y)) " " 8)))
                )
            )
        )
        (princ "\nNo block references were found in the active drawing.")
    )
    (princ)
)

(defun padright ( s c l )
    (repeat (- l (strlen s)) (setq s (strcat s c)))
    s
)

(defun padleft ( s c l )
    (repeat (- l (strlen s)) (setq s (strcat c s)))
    s
)

;; Block Name -> Effective Block Name  -  Lee Mac
;; blk - [str] Block name

(defun LM:name->effectivename ( blk / rep )
    (if
        (and (wcmatch blk "`**")
            (setq rep
                (cdadr
                    (assoc -3
                        (entget
                            (cdr (assoc 330 (entget (tblobjname "block" blk))))
                           '("AcDbBlockRepBTag")
                        )
                    )
                )
            )
            (setq rep (handent (cdr (assoc 1005 rep))))
        )
        (cdr (assoc 2 (entget rep)))
        blk
    )
)

;; Nested Assoc++  -  Lee Mac
;; Increments the value of a key in an association list with possible nested structure,
;; or adds the set of keys to the list if not present.
;; key - [lst] List of keys & subkeys
;; lst - [lst] Association list (may be nil)

(defun LM:nassoc++ ( key lst / itm )
    (if key
        (if (setq itm (assoc (car key) lst))
            (subst (cons (car key) (LM:nassoc++ (cdr key) (cdr itm))) itm lst)
            (cons  (cons (car key) (LM:nassoc++ (cdr key) nil)) lst)
        )
        (if lst (list (1+ (car lst))) '(1))
    )
)

(princ)

 

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...