Will this work? Please notice the two lines that need editing about the middle of the routine.
Code:
(DEFUN C:ADJUSTZ (/ CNT ENTITY PNT SS1 ZELEV ASC FIND_ATT )
;;; retrieve assoc data from entity
(defun ASC (ELEMENT ENTITY /) (cdr (assoc ELEMENT ENTITY)))
;;; Third Party Routine
(DEFUN FIND_ATT (E TAG / FOUND) ; begin FIND_ATT
(IF E ; check for existence of ENAME
; is selected object a BLOCK
(IF (= (CDR (ASSOC 0 (ENTGET E))) "INSERT")
; does it contain ATTRIBUTES
(IF (= (CDR (ASSOC 66 (ENTGET E))) 1)
(PROGN ; loop til correct ATTRIBUTE
(WHILE (NOT FOUND)
(IF E ; do not use an entget unless you have an entity
(PROGN
(IF (= (CDR (ASSOC 2 (ENTGET E))) (STRCASE TAG))
(SETQ FOUND T) ; break loop if found
(SETQ E (ENTNEXT E))
; if not correct ATT get next ATT
) ;end if
(IF FOUND ; return ename if found
E
) ;end if
) ;end progn
(PROGN ; if no match, tell me
(PRINC "\nNo matching attribute found.")
(SETQ FOUND T)
; break out of while loop by faking it out
NIL ; return nil if not found
) ;end progn
) ;end if
) ; end while
) ; end progn
(PROGN ; if no ATTR, tell me
(PROMPT "\nBlock has no ATTRIBUTES ")
NIL
) ;end progn
) ; end if
(PROGN
(PROMPT "\nNot a block ") ; if not a block, tell me
NIL
) ; end progn
) ; end if
(PROGN
(PROMPT "\nNothing selected ") ; if nothing selected, tell me
NIL
) ;end progn
) ; end if
)
;;; Set Attribute Name
(SETQ ATTRIBNAME "ZC")
(SETQ SS1 (SSGET '((0 . "INSERT")
(2 . "X") ;<-Adjust Block Name here
)
)
)
(IF SS1
(PROGN
(SETQ CNT (SSLENGTH SS1))
(REPEAT CNT
;(WHILE (NOT (SETQ ENTITY (ENTSEL "\nSelect X block: "))))
(SETQ ENTITY (ENTGET (SSNAME SS1 (SETQ CNT (1- CNT))))
PNT (ASC 10 ENTITY)
)
(IF (VL-STRING-SEARCH
"X"
(VLA-GET-EFFECTIVENAME
(VLAX-ENAME->VLA-OBJECT (ASC -1 ENTITY))
)
)
(SETQ ZELEV (FIND_ATT (ASC -1 ENTITY) ATTRIBNAME)
)
)
(IF ZELEV
(SETQ ZELEV (ASC 1 (ENTGET ZELEV)))
)
(IF (NUMBERP ZELEV)
(SETQ PNT (LIST (CAR PNT) (CADR PNT) ZELEV))
(SETQ PNT (LIST (CAR PNT) (CADR PNT) (ATOF ZELEV)))
)
(SETQ ENTITY (SUBST (CONS 10 PNT) (ASSOC 10 ENTITY) ENTITY))
(ENTMOD ENTITY)
)
)
)
)