AutoLISP Again: Dissecting Blocks

Image: AutoCAD icon.

UPDATE: The lisp now dissects any entity, not just a block.

A Reminder:

These blog posts are not the exercise. The code is the exercise, and that is where most of the useful information is to be found. If you only read my post and skip over the code block, you won't really learn anything of value. Dig into the code. Run it in AutoCAD, either alone or with VS Code.

This fourth exercise digs deeper into the innards of blocks.

All of the Lisp routines I use in my work involve blocks. Getting data, storing data, moving data from one to another. Having a good grasp of what blocks are and how they are defined, and what is hidden within them is pretty important. Learning some of the ways to get and see that data is also time well spent.

I wanted to be able to dig deep into the onion layers of block properties. This exercise goes a long way toward that goal.

This Lisp routine will open a new text window (console), and walks you through an interactive dissection of the block of your choice. Look for prompts as you go.

The Caveats

You will not walk away with a comprehensive understanding of block properties and values, but you will gain insight. That's a worthy cause.

I didn't worry about error-checking in this. If you wander outside the boundaries, things will go awry.

I am not repeating all the code comments from previous exercises. Google is your friend.

The Code

;; dissect-blocks.lsp - Pull the curtain back a bit further.
;; 2022 - Gregory A Sanders
;; - December 8, 2022 update: dissect all entity types, not just blocks.
;; Goals and steps:
;;    - Select an entity.
;;    - Take a look at two types of property lists: VLA/ActiveX and AutoLISP DXF codes.
;;    - Examine the lists within the lists of DXF codes.
;;    - Learn a TON about console feedback.
;;
(defun c:dissect ( / firstent firstentname firstentlist effname secondent thing secondentname keynum prevlist firstentlist 
              keynumint thisval)
  (sssetfirst nil nil)
  (setq effname "")
  (textscr)
  (repeat (1+ (atoi (getenv "CmdHistLines")))(terpri))
  (princ)
  (princ "\n:")
  (princ "\n--== EXPLORING BLOCKS, ATTRIBUTES AND VARIABLES ==--")
  (princ "\n--== We opened a new text screen so you can follow this. ==--")
  (princ "\n--== Sort of an old-school PowerPoint presentation. ==--")
  (princ "\n--== YOU WILL PROBABLY WANT TO STRETCH THIS WINDOW PRETTY LARGE.")
  (princ "\n--== Much text follows.  And some of the lists are long.")
  (princ "\n:")
  (setq firstent (entsel "\nSelect a block (selecting anything else will error out): "))            ; Prompt user to select a block. Return entity definition.
  (princ "\n:")
  (princ "\n--== Block entity retrieved. ==--")
  (princ "\n:")
  (princ (strcat "\nWe saved the block entity to a variable named 'firstent'."))
  (princ (strcat "\nThe contents of that variable look like this: " (vl-prin1-to-string firstent)))
  (princ (strcat "\nIt's a list containing the entity name followed by the selection point coordinates."))
  (princ "\n:")
  (setq firstentname (car firstent))                                                                ; Get the first value from the list.
  (princ (strcat "\n'(car firstent)' gives us the first value: the AutoLISP entity name from that list."))
  (princ (strcat "\nIt looks like this: " (vl-prin1-to-string firstentname)))                       ; '(vl-prin1-to-string variable) gives text output regardless of data type.
  (princ "\n:")
  (setq firstentcoords (cdr firstent))                                                              ; Get the second value from the list.
  (princ (strcat "\n'(cdr firstent)' gives us the second value: the coordinates of the crosshairs at the time of selection."))
  (princ (strcat "\nIt looks like this: " (vl-prin1-to-string firstentcoords)))
  (princ "\nThe coordinates provide no real benefit, and will just be ignored in our exercise.")
  (princ "\n:")
  (setq theobj (vlax-ename->vla-object firstentname))                                               ; Get the VLA object name.
  (princ (strcat "\n'(vlax-ename->vla-object)' changes: '" (vl-prin1-to-string firstentname) "' 
                into: '" (vl-prin1-to-string theobj) "'."))
  (princ (strcat "\nThat provides a VLA-object value to pass to (vlax-get-property) or (vlax-dump-object)."))
  (if (/= (vlax-property-available-p theobj 'effectivename) nil)
    (progn
      (princ "\n:")
      (princ "\nThe statement: '(setq effname (vlax-get-property theobj 'effectivename))' gets us the value from EffectiveName.")
      (setq effname (vlax-get-property theobj 'effectivename))                                          ; Get the human-readable block name using the VLA object name.
      (princ "\n:")
      (princ (strcat "\n'EffectiveName' is the key. This is the value: " effname))
    )
  )
  (holdup)                                                                                          ; Run the holdup function (defined below).
  (princ "\n:")
  (princ "\nHere's a dump of the VLA/ActiveX properties of our selected block:")
  (vlax-dump-object theobj)                                                                         ; Print the VLA/ActiveX properties of the entity (block).

  (princ "\n:")
  (princ "\nLet's print the old-school AutoLISP properties of the same block for comparision.")
  (princ "\n:")
  (setq firstentlist (entget firstentname))                                                         ; Get the older DXF codes (properties) for the block (entity).
  (foreach thing firstentlist                                                                       ; Use (foreach to produce a nice vertical list of properties.
    (princ (strcat "\n" (vl-prin1-to-string thing)))
  )
  (princ "\n:")
  (princ "\nYou can see that these values are not nearly as useful as the set from the newer VLA/ActiveX set.")
  (princ "\nWhile that is true, these older entites are not use-LESS.  There's much that can be learned from them.")
  (princ "\nEach entry here in parentheses is one key.value pair.  Many of them are pointers leading to another such list.")
  (princ "\nI want to dig down into one of those sub-entities.  To do that, I'll use the key to ask for more info.")
  (princ "\n:")
  (setq keynum "")
  (setq prevlist firstentlist)
  (while (/= keynum "stop")
    (setq keynum (getstring "\nWhich key do you want to see values for? ('stop' to exit)"))
    (setq keynumint (atoi keynum))
      (if (/= keynum "stop")
        (progn
          (if (= (type(cdr (assoc keynumint prevlist))) 'ENAME)
            (progn
              (setq thislist (entget (cdr (assoc keynumint prevlist))))
              (princ (strcat "\n--== Key " keynum " from the previous list."))
              (princ "\n:")
                (foreach thing thislist
                  (princ (strcat "\n" (vl-prin1-to-string thing)))
                )
              (setq prevlist thislist)
            )
            (progn
              (princ "\n--== That key is associated with a value instead of a list. ==--")
              (princ "\n")
            )
          )
          (if (/= (type(cdr (assoc keynumint prevlist))) 'ENAME)
            (progn
              (setq prevlistiter 0)
              (setq prevlistlen (length prevlist))
              (while (<= prevlistiter prevlistlen)
                (if (= (car (nth prevlistiter prevlist)) keynumint)
                  (progn
                    (setq thisval (cdr (nth prevlistiter prevlist)))
                    (princ (strcat "\nThe value associated with key " keynum " is " (vl-princ-to-string thisval)))
                    (princ "\n")
                  )
                )
                (setq prevlistiter (+ prevlistiter 1))

              )
            )
          )
        )
      )
    )

  (princ "\n--== RECAP: From this one block, we have uncovered many different lists and values.")
  (princ "\n--== We did not investigate every option.  And these are just the old-school AutoLISP properties.")
  (princ "\n--== We haven't dug into the VLA/ActiveX properties very much.")
  (princ "\n--== This demonstrates that there is a ton of data here just waiting to be accessed.")
  (princ "\n--== If you dug deep enough, you saw the convoluted linking inside those datasets. Wow.")
    (princ "\n:")
  (princ "\n--== That's about as far as I want to take this.  Learning is fun, but tiring.")
  (princ "\n--== You can close this text window now. ==--")
  (princ "\n:")
  (princ)                                                                       ;Clean console exit.

) ; Close (defun c:wgnv


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; RANDOM SUPPORTING FUNCTIONS ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Hold up a minute.
(defun holdup ( / gonogo)
  (setq gonogo nil)
  (princ "\n:")
  (setq gonogo (prompt "\n--== Press any key to continue. ==--"))
  (setq gonogo (grread))
  (if (/= gonogo nil)
    (princ "\n--== OK. You pressed a key. ==-- ")
  )
)
;
(defun c:clear ()
(repeat (1+ (atoi (getenv "CmdHistLines")))(terpri))
(princ)
)

That does it for this exercise. I gained a boatload of valuable experience writing this.

It's a Thing That Works!

Next up: Blocks in proximity.

link to home page

links