337 lines
10 KiB
Common Lisp
337 lines
10 KiB
Common Lisp
;; 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)
|
|
|
|
|