;; AS_AttrBatch.lsp
;; Batch-edit a single attribute tag for all matching AS* blocks inside a user selection.
;; Command: ASBATCHATTR
;;
;; Command-line version (no dialog/DCL).

(defun asba:_unique (lst / out)
  (foreach x lst
    (if (not (member x out))
      (setq out (cons x out))
    )
  )
  (reverse out)
)

(defun asba:_ss->list (ss / i out)
  (setq i 0 out '())
  (if ss
    (while (< i (sslength ss))
      (if (= (type (ssname ss i)) 'ENAME)
        (setq out (cons (ssname ss i) out))
      )
      (setq i (1+ i))
    )
  )
  (reverse out)
)

(defun asba:_effname (ename / ed nm r obj)
  ;; Try to get the "EffectiveName" (handles dynamic blocks).
  ;; Fully guarded: if anything fails, fall back to DXF group 2.
  (setq nm nil)
  (if (= (type ename) 'ENAME)
    (progn
      ;; COM path (safe) -> try to set nm
      (setq r (vl-catch-all-apply 'vl-load-com '()))
      (setq r (vl-catch-all-apply 'vlax-ename->vla-object (list ename)))
      (if (not (vl-catch-all-error-p r))
        (progn
          (setq obj r)
          (setq r (vl-catch-all-apply 'vlax-property-available-p (list obj 'EffectiveName)))
          (if (and (not (vl-catch-all-error-p r)) r)
            (progn
              (setq r (vl-catch-all-apply 'vla-get-EffectiveName (list obj)))
              (if (and (not (vl-catch-all-error-p r)) (= (type r) 'STR))
                (setq nm r)
              )
            )
          )
        )
      )

      ;; DXF fallback if nm not found
      (if (not nm)
        (progn
          (setq ed (entget ename))
          (setq r (cdr (assoc 2 ed)))
          (if (= (type r) 'STR) (setq nm r))
        )
      )
    )
  )
  nm
)

(defun asba:_attrib-tags-of-insert (ins / e ed tags tagTmp)
  ;; Read attribute TAGs using DXF traversal (avoids VLA objects/variants).
  (setq tags '())
  (setq e (entnext ins))
  (while (and e (setq ed (entget e)) (= (cdr (assoc 0 ed)) "ATTRIB"))
    (setq tagTmp (cdr (assoc 2 ed)))
    (if (= (type tagTmp) 'STR)
      (setq tags (cons (strcase tagTmp) tags))
    )
    (setq e (entnext e))
  )
  tags
)

(defun asba:_find-first-insert-by-name (ss blockName / enames e nm)
  (setq enames (asba:_ss->list ss))
  (setq e nil)
  (foreach x enames
    (if (and (null e)
             (= (type x) 'ENAME)
             (= (cdr (assoc 0 (entget x))) "INSERT"))
      (progn
        (setq nm (asba:_effname x))
        (if (and (= (type nm) 'STR) (= (strcase nm) (strcase blockName)))
          (setq e x)
        )
      )
    )
  )
  e
)

(defun asba:_set-attrib-value-on-insert (ins tag newValue / e ed curTag)
  ;; Update only the chosen TAG on a single INSERT.
  ;; Returns T if changed, NIL otherwise.
  (setq e (entnext ins))
  (while (and e (setq ed (entget e)) (= (cdr (assoc 0 ed)) "ATTRIB"))
    (setq curTag (cdr (assoc 2 ed)))
    (if (and (= (type curTag) 'STR) (= (strcase curTag) (strcase tag)))
      (progn
        (if (assoc 1 ed)
          (setq ed (subst (cons 1 newValue) (assoc 1 ed) ed))
          (setq ed (append ed (list (cons 1 newValue))))
        )
        (entmod ed)
        (entupd ins)
        (setq e nil) ;; stop after first match
        (setq ed T)  ;; reuse as "changed" flag
      )
      (setq e (entnext e))
    )
  )
  (if (= ed T) T nil)
)

(defun asba:_blocks-in-selection (ss / enames names nm)
  ;; Kept for backward compatibility (returns unique names only).
  (mapcar 'car (asba:_block-counts-in-selection ss))
)

(defun asba:_block-counts-in-selection (ss / enames counts nm cell)
  ;; Returns alist: (("AS_VFD" . 50) ("AS_PMM" . 1) ...)
  (setq enames (asba:_ss->list ss))
  (setq counts '())
  (foreach e enames
    (if (= (cdr (assoc 0 (entget e))) "INSERT")
      (progn
        (setq nm (asba:_effname e))
        (if (and (= (type nm) 'STR) (wcmatch (strcase nm) "AS*"))
          (progn
            (setq nm (strcase nm))
            (setq cell (assoc nm counts))
            (if cell
              (setq counts (subst (cons nm (1+ (cdr cell))) cell counts))
              (setq counts (cons (cons nm 1) counts))
            )
          )
        )
      )
    )
  )
  ;; sort by name
  (vl-sort counts '(lambda (a b) (< (car a) (car b))))
)

(defun asba:_counts->display (alist / out)
  (setq out '())
  (foreach p alist
    (setq out (cons (strcat (car p) " (" (itoa (cdr p)) ")") out))
  )
  (reverse out)
)

(defun asba:_attrs-for-block (ss blockName / ins tags)
  ;; Attributes are normally consistent across block references.
  ;; To avoid scanning every insert (and any weird/proxy entities), read tags from the first valid insert.
  (setq ins (asba:_find-first-insert-by-name ss blockName))
  (if ins
    (progn
      (setq tags (asba:_attrib-tags-of-insert ins))
      (setq tags (asba:_unique tags))
      (vl-sort tags '<)
    )
    '()
  )
)

(defun asba:_apply-attr (ss blockName tag newValue / enames changed nm attrefs att)
  (setq enames (asba:_ss->list ss))
  (setq changed 0)
  (foreach e enames
    (if (= (cdr (assoc 0 (entget e))) "INSERT")
      (progn
        (setq nm (asba:_effname e))
        (if (and (= (type nm) 'STR) (= (strcase nm) (strcase blockName)))
          (progn
            (if (asba:_set-attrib-value-on-insert e tag newValue)
              (setq changed (1+ changed))
            )
          )
        )
      )
    )
  )
  changed
)

(defun asba:_print-numbered (title items / i)
  (prompt (strcat "\n" title))
  (setq i 1)
  (foreach it items
    (prompt (strcat "\n  " (itoa i) ") " it))
    (setq i (1+ i))
  )
)

(defun asba:_choose-index (promptText maxN / n)
  (setq n nil)
  (while (not n)
    (setq n (getint (strcat "\n" promptText " (1-" (itoa maxN) ", Enter to cancel): ")))
    (cond
      ((null n) (setq n 0))
      ((or (< n 1) (> n maxN))
       (prompt "\nInvalid number.")
       (setq n nil)
      )
    )
  )
  n
)

(defun asba:_ss-has (ss ename)
  ;; returns T if ename is in selection set ss
  (if (and ss ename)
    (if (ssmemb ename ss) T nil)
    nil
  )
)

(defun asba:_pick-block-from-ss (ss / sel ename nm)
  (setq nm nil)
  (while (not nm)
    (setq sel (entsel "\nClick a block (AS*) inside the selected zone (Enter to cancel): "))
    (cond
      ((null sel) (setq nm "")) ;; cancelled
      (t
       (setq ename (car sel))
       (if (and ename (= (cdr (assoc 0 (entget ename))) "INSERT") (asba:_ss-has ss ename))
         (progn
           (setq nm (asba:_effname ename))
           (if (not (and (= (type nm) 'STR) (wcmatch (strcase nm) "AS*")))
             (progn (prompt "\nThat block name does not start with AS*.") (setq nm nil))
           )
         )
         (progn (prompt "\nPlease click a block INSERT that is inside your selected zone.") (setq nm nil))
       )
      )
    )
  )
  (if (= nm "") nil nm)
)

(defun asba:_getstring-safe (msg / r)
  ;; Some AutoCAD builds do not support (getstring T ...). Use the simplest form.
  (setq r (getstring msg))
  r
)

(defun c:ASBATCHATTR (/ ss blockCounts blockNames blockDisplay mode block bIdx attrs tag aIdx newVal changed blkTotal)
  (vl-load-com)

  (prompt "\nSelect a zone/area (window/crossing allowed). Press Enter when done...")
  (setq ss (ssget))
  (if (not ss)
    (progn (prompt "\nNothing selected.") (princ))
    (progn
      (setq blockCounts (asba:_block-counts-in-selection ss))
      (setq blockNames (mapcar 'car blockCounts))
      (setq blockDisplay (asba:_counts->display blockCounts))
      (if (not blockNames)
        (progn (prompt "\nNo blocks found with name starting with AS* in the selection.") (princ))
        (progn
          ;; Choose block: Pick (mouse) or List (numbered)
          (initget "Pick List")
          (setq mode (getkword "\nChoose block by [Pick/List] <Pick>: "))
          (if (null mode) (setq mode "Pick"))

          (cond
            ((= mode "Pick")
             (setq block (asba:_pick-block-from-ss ss))
            )
            (t
             (asba:_print-numbered "Unique blocks (AS*) with counts:" blockDisplay)
             (setq bIdx (asba:_choose-index "Choose block number" (length blockNames)))
             (setq block (if (= bIdx 0) nil (nth (1- bIdx) blockNames)))
            )
          )

          (if (not block)
            (progn (prompt "\nCancelled.") (princ))
            (progn
              (setq blkTotal (cdr (assoc (strcase block) blockCounts)))
              (setq attrs (asba:_attrs-for-block ss block))
              (if (not attrs)
                (progn (prompt (strcat "\nBlock " block " has no attributes in the selection.")) (princ))
                (progn
                  ;; Choose attribute: numbered list only (reliable + matches requested workflow)
                  (asba:_print-numbered (strcat "Unique attribute tags for " block ":") attrs)
                  (setq aIdx (asba:_choose-index "Choose attribute number" (length attrs)))
                  (setq tag (if (= aIdx 0) nil (nth (1- aIdx) attrs)))

                  (if (not tag)
                    (progn (prompt "\nCancelled.") (princ))
                    (progn
                      (setq newVal (asba:_getstring-safe (strcat "\nNew value for tag " tag " (Enter to cancel): ")))
                      ;; If user presses Enter immediately, AutoCAD may return "".
                      (if (or (null newVal) (= newVal ""))
                        (progn (prompt "\nCancelled.") (princ))
                        (progn
                          (setq changed (asba:_apply-attr ss block tag newVal))
                          (command "_.REGEN")
                          (prompt
                            (strcat
                              "\nDone. Changed "
                              (itoa changed)
                              " block(s) out of "
                              (itoa (if blkTotal blkTotal 0))
                              " selected "
                              block
                              " block(s)."
                            )
                          )
                          (princ)
                        )
                      )
                    )
                  )
                )
              )
            )
          )
        )
      )
    )
  )
)

(princ "\nLoaded AS_AttrBatch. Run command: ASBATCHATTR")
(princ)