AutoLisp - Two basic functions: Determining the number and value ​of block attributes

Question

I have to write the function that determines the number and values ​​of block attributes in AutoLisp. I have function which count the atributes:

(defun c:Test (/ s ss)
  (if (and (princ "\n Select FIRST Attributed Block :")
           (setq s (ssget "_+.:S:E" '((0 . "INSERT") (66 . 1))))
           (princ "\n Select the SECOND Attributed Block :")
           (setq ss (ssget "_+.:S:E" '((0 . "INSERT") (66 . 1))))
      )
    (mapcar
      'length
      (mapcar
        '(lambda (a)
           (mapcar
             '(lambda (x) (vla-get-textstring x))
             (vlax-invoke (vlax-ename->vla-object a) 'getattributes)
           )
         )
        (list (ssname s 0) (ssname ss 0))
      )
    )
  )
)**

A function that returns the values ​​of attributes:

(defun c:Test (/ ss n e x)
  (while (progn (princ "\n Select single attributed block :")
                (setq ss (ssget "_+.:S" '((0 . "INSERT") (66 . 1))))
         )
    (setq n (entnext (ssname ss 0)))
    (while (not (eq (cdr (assoc 0 (setq e (entget n)))) "SEQEND" ))
       (if (eq (cdr (assoc 0 e)) "ATTRIB")
         (print (cdr (assoc 1 e)))
       )
       (setq n (entnext n))
    )
  )
  (princ)
)

Could you help me to combine this to functions into one?

Answer 1

Here is a lisp program that will loop over all blocks from a user selection set and:
1.) print block name
2.) print the association list of AttributeTag.AttributeValue
3.) print the list of AttributeTags
4.) print the list of AttributeValues
5.) print the number of AttributeValues

I also attached what the command line output should look like.

Lisp command line output

;;www.cadwiki.net

(defun c:test (/ SSINPUT)
  (setq ssInput (ssget (list '(0 . "insert"))))
  (PRINT-BLOCK-ATTRIBUTE-INFO ssInput)
  (princ)
)


(defun PRINT-BLOCK-ATTRIBUTE-INFO (ssInput / ATTRIBUTETAGS ATTRIBUTETAGSTOVALUES ATTRIBUTEVALUES BLOCKENTITY BLOCKVLAOBJECT I NUMBEROFBLOCKATTRIBUTES
                                  )
  (setq i 0)
  (if (= ssInput nil)
    (progn
      (princ "ssInput was nothing, exiting.")
      (exit)
    )
  )
  (princ (strcat "\nItems in selection set: " (itoa (sslength ssInput))))
  (while (< i (sslength ssInput))
    (setq blockEntity (ssname ssInput i))
    (setq blockVlaObject (vlax-ename->vla-object blockEntity))
    (setq attributeTagsToValues (GET-BLOCK-ATTRIBUTE-NAME-TO-VALUE-ASSOC blockEntity))
    (princ (strcat "\nBlock name: " (vla-get-name blockVlaObject)))
    (princ "\nBlock attributes tag to values association list: ")
    (princ attributeTagsToValues)
    (setq attributeTags (GET-NTHS-FROM-LISTS 0 attributeTagsToValues nil))
    (princ "\nBlock attribute tags list: ")
    (princ attributeTags)
    (setq attributeValues (GET-LAST-ITEM-FROM-EACH-LIST attributeTagsToValues))
    (princ "\nBlock attributes values list: ")
    (princ attributeValues)
    (princ "\nNumber of block attributes: ")
    (setq numberOfBlockAttributes (itoa (length attributeValues)))
    (princ numberOfBlockAttributes)
    (setq i (+ i 1))
  )
)

(defun GET-NTHS-FROM-LISTS (N LSTs removeDuplicates / CT LST2 LST IT)
  (setq LST2 nil)
  (foreach LST LSTs
    (setq IT (nth N LST))
    (if removeDuplicates
      (if (not (member IT LST2))
        (setq LST2 (append LST2 (list IT)))
      )
      (setq LST2 (append LST2 (list IT)))
    )
  )
  LST2
)

(defun GET-LAST-ITEM-FROM-EACH-LIST (LSTs / CDRs FAIL LST)
  (setq CDRs nil
        FAIL nil
  )
  (if (not (= (type LSTs) 'LIST))
    (setq FAIL "not a list")
  )
  (if (not FAIL)
    (foreach LST LSTs
      (setq FAIL (cond
                   ((not (= (type LST) 'LIST)) "non-list member")
                   ((not (cdr LST)) "no CDR")
                   (T nil)
                 )
      )
      (if (not FAIL)
        (setq CDRs (append CDRs (list (cdr LST))))
      )
    )
  )
  CDRs
)

(defun GET-BLOCK-ATTRIBUTE-NAME-TO-VALUE-ASSOC (entity / COUNTER COUNTER2 COUNTERMAX COUNTERMAX2 DXFCODE0 DXFCODE2 DXFCODE66 DXFCODE8 DXFCODECODE-1 ENTITIESTORETURN ENTITYDXFCODES *ERROR* RETURNLIST
                                                SUPPLIEDTRUENAME TRUENAME ATTRIBUTETAG ATTRIBUTEVALUE DXFCODE-1 ENTITYNAMEFORDRILLING SUBLIST TAGSANDVALUES THECALLINGFUNCTIONSNAME
                                               )

  (setq counter 0) ;initialize counter to 0 for while loop
  (if ;if
    (/= entity nil) ;entity is not nil
     (progn ;progn wrap
       (setq entityDxfCodes (entget entity)) ;set the varaible entityDxfCodes to the list of entities from the en varaible
       ;; you can use the method here to find any value from a dxfCodecode
       (setq dxfCode-1 (cdr (assoc -1 entityDxfCodes))) ;set dxfCode-1 to the second element of the item that has -1 as it's first element, this is the entity name
       (setq dxfCode0 (cdr (assoc 0 entityDxfCodes))) ;set dxfCode0 to the element of the item that has 0 as it's first element, this is the entity type
       (setq dxfCode2 (cdr (assoc 2 entityDxfCodes))) ;set dxfCode8 to the second element of the item that has 8 as it's first element, this is the name, or block name
       (setq dxfCode8 (cdr (assoc 8 entityDxfCodes))) ;set dxfCode8 to the second element of the item that has 8 as it's first element, this is the layer
       (setq dxfCode66 (cdr (assoc 66 entityDxfCodes))) ;set dxfCode66 to the second element of the item that has 66 as it's first element, this is the attribute flag
       (setq entityNameForDrilling entity)
       (if ;if start
         (= dxfCode66 1) ;entity attribute flag is 1
          (progn ;progn wrap
            (while (/= dxfCode0 "SEQEND") ;while loop to drill to each sub entity in a block
              (setq attributeTag (cdr (assoc 2 entityDxfCodes))) ;set attributeTag to the second element of the second Dxf code (assoc 2) of the entityDxfCodes variable
              (setq attributeValue (cdr (assoc 1 entityDxfCodes))) ;set attributeValue to the second element of the first Dxf code (assoc 1) of the entityDxfCodes variable
              (if
                (/= attributeValue nil)
                 (progn
                   (setq sublist (cons attributeTag attributeValue))
                   (setq tagsAndValues (cons sublist TagsAndValues))
                 )
              )
              (setq entityNameForDrilling (entnext entityNameForDrilling))
              (setq entityDxfCodes (entget entityNameForDrilling))
              (setq dxfCode0 (cdr (assoc 0 entityDxfCodes)))
            )
          ) ;progn wrap end
       ) ;if end
     ) ;progn wrap end
  ) ;if end
  (setq returnList tagsAndValues)
)