Announcements

The Autodesk Community Forums has a new look. Read more about what's changed on the Community Announcements board.

Automatically label attributes

h_s_walker
Mentor

Automatically label attributes

h_s_walker
Mentor
Mentor

Ok so I have found Lee Mac's brilliant Automatic labelling lisp at the link below

Automatically Label Attributes | Lee Mac Programming (lee-mac.com)

Now it doesn't quite work how I would like.

Instead of the number incrementing can it instead get the characters after the "-" in a layout tab?

Also can the suffix be made to increment?

eg his code goes 1a, 2a, 3a

We might have a layout labelled A2_1234-56, and one labelled A2_1234a-48

So on the first page the blocks would go P56a, P56b..., and on the second one they would go P48a, P48b...

His code is below, with some very minor changes from me.

;;---------------------=={ AutoLabel Attributes }==---------------------;;
;;                                                                      ;;
;;  This program will automatically populate a specific attribute tag   ;;
;;  with a unique label within a set of attributed blocks, renumbering  ;;
;;  if blocks are added, copied or erased.                              ;;
;;                                                                      ;;
;;  The program uses an Object Reactor to monitor modification events   ;;
;;  for the set of all attributed blocks with a block name matching     ;;
;;  a block name or wildcard pattern specified within the program       ;;
;;  source code.                                                        ;;
;;                                                                      ;;
;;  Following modification to any matching attributed block, a Command  ;;
;;  Reactor will trigger the program to automatically renumber a        ;;
;;  specific attribute tag held by all matching attributed blocks in    ;;
;;  the active layout of the drawing.                                   ;;
;;                                                                      ;;
;;  The block references are numbered in the order in which they are    ;;
;;  encountered in the drawing database of the active drawing           ;;
;;  (that is, the order in which the blocks were created).              ;;
;;                                                                      ;;
;;  The program also allows the user to specify a numbering prefix &    ;;
;;  suffix, the starting number for the numbering, and the number of    ;;
;;  characters to be used for fixed length numbering with leading zeros ;;
;;  (i.e. if the numbering length is set to 2, the program will number  ;;
;;  the blocks 01,02,03,...,10,11,12).                                  ;;
;;                                                                      ;;
;;  The autonumbering functionality is automatically enabled on drawing ;;
;;  startup when the program is loaded, and may be subsequently enabled ;;
;;  or disabled manually using the commands 'AUTOLABELON' &             ;;
;;  'AUTOLABELOFF' respectively.                                        ;;
;;----------------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright � 2011 - www.lee-mac.com                 ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2011-09-14                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2015-09-20                                      ;;
;;                                                                      ;;
;;  - Program entirely rewritten.                                       ;;
;;  - Added callback function to handle command cancelled & command     ;;
;;    failed events when modifying autonumbered blocks.                 ;;
;;  - Added the ability to specify a numbering prefix & suffix,         ;;
;;    specify a starting number, and use fixed length numbering         ;;
;;    (i.e numbering with leading zeros: 01,02,...,10).                 ;;
;;  - Block Name & Attribute Tag parameters may now use wildcards to    ;;
;;    match multiple block names & tags (the first attribute tag which  ;;
;;    matches the wildcard pattern will be numbered).                   ;;
;;  - Incorporated compatibility for Multiline Attributes.              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    2015-09-27                                      ;;
;;                                                                      ;;
;;  - Program modified to only increment numbering counter if an        ;;
;;    attribute matching the target tag name is found.                  ;;
;;  - Implemented compatibility for multileader blocks.                 ;;
;;----------------------------------------------------------------------;;
;;  Version 1.3    -    2018-10-27                                      ;;
;;                                                                      ;;
;;  - Fixed bug in autolabel:getattributetagid function preventing      ;;
;;    numbering of multileader attributed blocks.                       ;;
;;----------------------------------------------------------------------;;
;;  Version 1.4    -    2020-02-15                                      ;;
;;                                                                      ;;
;;  - Program modified to account for attributed MInsert Blocks.        ;;
;;----------------------------------------------------------------------;;

(setq

;;----------------------------------------------------------------------;;
;;                               Settings                               ;;
;;----------------------------------------------------------------------;;

    autolabel:blockname "PHOTOFRAME"  ;; Name of block to be updated (not case-sensitive / may use wildcards)
    autolabel:blocktag  "PHREF"    ;; Attribute tag to be updated (not case-sensitive / may use wildcards)
    autolabel:prefix    "P"         ;; Numbering prefix (use "" for none)
    autolabel:suffix    "a"         ;; Numbering suffix (use "" for none)
    autolabel:start     1          ;; Starting number
    autolabel:length    1          ;; Fixed length numbering (set to zero if not required)
    autolabel:startup   t          ;; Enable on drawing startup (t=enable / nil=disable)
    autolabel:objtype   3          ;; Bit-coded integer > 0 (1=attributed blocks; 2=multileader blocks)

;;----------------------------------------------------------------------;;

)

;;----------------------------------------------------------------------;;
;;                             Main Program                             ;;
;;----------------------------------------------------------------------;;

(defun autolabel:objectreactorcallback:renumberblocks ( own rtr arg )
    (if (null autolabel:commandreactor)
        (setq autolabel:commandreactor
            (vlr-command-reactor "autolabel"
               '(
                    (:vlr-commandended     . autolabel:commandreactorcallback:renumberblocks)
                    (:vlr-commandcancelled . autolabel:commandreactorcallback:cancelled)
                    (:vlr-commandfailed    . autolabel:commandreactorcallback:cancelled)
                )
            )
        )
    )
    (princ)
)

(defun autolabel:commandreactorcallback:cancelled ( rtr arg )
    (if (= 'vlr-command-reactor (type autolabel:commandreactor))
        (progn
            (vlr-remove autolabel:commandreactor)
            (setq autolabel:commandreactor nil)
        )
    )
    (princ)
)

(defun autolabel:commandreactorcallback:renumberblocks ( rtr arg / att blk idx num obj oid sel )
    (if (= 'vlr-command-reactor (type autolabel:commandreactor))
        (progn
            (vlr-remove autolabel:commandreactor)
            (setq autolabel:commandreactor nil)
        )
    )
    (if (= 'vlr-object-reactor (type autolabel:objectreactor))
        (vlr-remove autolabel:objectreactor)
    )
    (if
        (and (not autolabel:undoflag)
            (setq sel
                (ssget "_X"
                    (append
                        (if (= 3 (logand 3 autolabel:objtype))
                           '((-4 . "<OR"))
                        )
                        (if (= 1 (logand 1 autolabel:objtype))
                            (list '(-4 . "<AND") '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`*U*," autolabel:blockname)) '(-4 . "AND>"))
                        )
                        (if (= 2 (logand 2 autolabel:objtype))
                           '((0 . "MULTILEADER"))
                        )
                        (if (= 3 (logand 3 autolabel:objtype))
                           '((-4 . "OR>"))
                        )
                        (if (= 1 (getvar 'cvport))
                            (list (cons 410 (getvar 'ctab)))
                           '((410 . "Model"))
                        )
                    )
                )
            )
        )
        (progn
            (setq num autolabel:start)
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (wcmatch (vla-get-objectname obj) "AcDbBlockReference,AcDbMInsertBlock")
                    (if (setq att (autolabel:getattribute obj))
                        (progn
                            (vla-put-textstring att
                                (strcat
                                    autolabel:prefix
                                    (autolabel:padzeros (itoa num) autolabel:length)
                                    autolabel:suffix
                                )
                            )
                            (setq num (1+ num))
                            (autolabel:addowner obj)
                        )
                    )
                    (if (and (= acblockcontent (vla-get-contenttype obj))
                             (wcmatch (setq blk (strcase (vla-get-contentblockname obj))) autolabel:blockname)
                             (setq oid (autolabel:getattributetagid blk))
                        )
                        (progn
                            (autolabel:setblockattributevalue obj oid
                                (strcat
                                    autolabel:prefix
                                    (autolabel:padzeros (itoa num) autolabel:length)
                                    autolabel:suffix
                                )
                            )
                            (setq num (1+ num))
                            (autolabel:addowner obj)
                        )
                    )
                )
            )
        )
    )
    (if (= 'vlr-object-reactor (type autolabel:objectreactor))
        (vlr-add autolabel:objectreactor)
    )
    (princ)
)

(defun autolabel:commandreactorcallback:undocheck ( rtr arg )
    (setq autolabel:undoflag (= (strcase (car arg) t) "undo"))
    (princ)
)

(defun autolabel:commandreactorcallback:blockinserted ( rtr arg / att blk ent enx idx new num obj oid sel )
    (if
        (and
            (not autolabel:undoflag)
            (wcmatch (strcase (car arg) t)
                (strcat
                    (if (= 1 (logand 1 autolabel:objtype)) "-insert,insert,executetool" "")
                    (if (= 3 (logand 3 autolabel:objtype)) "," "")
                    (if (= 2 (logand 2 autolabel:objtype)) "mleader" "")
                )
            )
            (setq ent (entlast))
            (setq new (vlax-ename->vla-object ent))
            (setq enx (entget ent))
            (or
                (and
                    (= 1 (logand 1 autolabel:objtype))
                    (= "INSERT" (cdr (assoc 0 enx)))
                    (= 1 (cdr (assoc 66 enx)))
                    (wcmatch (autolabel:effectivename new) autolabel:blockname)
                )
                (and
                    (= 2 (logand 2 autolabel:objtype))
                    (= "MULTILEADER" (cdr (assoc 0 enx)))
                    (= acblockcontent (vla-get-contenttype new))
                    (wcmatch (strcase (vla-get-contentblockname new)) autolabel:blockname)
                )
            )
            (setq sel
                (ssget "_X"
                    (append
                        (if (= 3 (logand 3 autolabel:objtype))
                           '((-4 . "<OR"))
                        )
                        (if (= 1 (logand 1 autolabel:objtype))
                            (list '(-4 . "<AND") '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`*U*," autolabel:blockname)) '(-4 . "AND>"))
                        )
                        (if (= 2 (logand 2 autolabel:objtype))
                           '((0 . "MULTILEADER"))
                        )
                        (if (= 3 (logand 3 autolabel:objtype))
                           '((-4 . "OR>"))
                        )
                        (if (= 1 (getvar 'cvport))
                            (list (cons 410 (getvar 'ctab)))
                           '((410 . "Model"))
                        )
                    )
                )
            )
        )
        (progn
            (setq num (1- autolabel:start))
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (wcmatch (vla-get-objectname obj) "AcDbBlockReference,AcDbMInsertBlock")
                    (if (autolabel:getattribute obj)
                        (setq num (1+ num))
                    )
                    (if (and (= acblockcontent (vla-get-contenttype obj))
                             (wcmatch (setq blk (strcase (vla-get-contentblockname obj))) autolabel:blockname)
                             (autolabel:getattributetagid blk)
                        )
                        (setq num (1+ num))
                    )
                )
            )
            (if (wcmatch (vla-get-objectname obj) "AcDbBlockReference,AcDbMInsertBlock")
                (if (setq att (autolabel:getattribute new))
                    (progn
                        (vla-put-textstring att
                            (strcat
                                autolabel:prefix
                                (autolabel:padzeros (itoa num) autolabel:length)
                                autolabel:suffix
                            )
                        )
                        (autolabel:addowner new)
                    )
                )
                (if (setq oid (autolabel:getattributetagid (vla-get-contentblockname new)))
                    (progn
                        (autolabel:setblockattributevalue new oid 
                            (strcat
                                autolabel:prefix
                                (autolabel:padzeros (itoa num) autolabel:length)
                                autolabel:suffix
                            )
                        )
                        (autolabel:addowner new)
                    )
                )
            )
        )
    )
    (princ)
)

(defun autolabel:addowner ( obj )
    (if
        (and
            (= 'vlr-object-reactor (type autolabel:objectreactor))
            (not (member obj (vlr-owners autolabel:objectreactor)))
        )
        (vlr-owner-add autolabel:objectreactor obj)
    )
)

(defun autolabel:getattribute ( blk )
    (if (wcmatch (strcase (autolabel:effectivename obj)) autolabel:blockname)
        (vl-some
           '(lambda ( att )
                (if (wcmatch (strcase (vla-get-tagstring att)) autolabel:blocktag) att)
            )
            (vlax-invoke blk 'getattributes)
        )
    )
)

(defun autolabel:getattributetagid ( blk )
    (eval
        (list 'defun 'autolabel:getattributetagid '( blk / itm tmp )
            (list 'if
               '(setq itm (assoc (strcase blk) autolabel:attributetagids))
               '(cdar (vl-member-if '(lambda ( att ) (wcmatch (car att) autolabel:blocktag)) (cdr itm)))
                (list 'progn
                    (list 'vlax-for 'obj (list 'vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) 'blk)
                       '(if
                            (and
                                (= "AcDbAttributeDefinition" (vla-get-objectname obj))
                                (= :vlax-false (vla-get-constant obj))
                            )
                            (setq tmp
                                (cons
                                    (cons
                                        (strcase (vla-get-tagstring obj))
                                        (autolabel:objectid obj)
                                    )
                                    tmp
                                )
                        	)
                        )
                    )
                   '(setq autolabel:attributetagids (cons (cons (strcase blk) tmp) autolabel:attributetagids))
                   '(autolabel:getattributetagid blk)
                )
            )
        )
    )
    (autolabel:getattributetagid blk)
)

(defun autolabel:setblockattributevalue ( obj idx str )
    (if (vlax-method-applicable-p obj 'setblockattributevalue32)
        (defun autolabel:setblockattributevalue ( obj idx str ) (vla-setblockattributevalue32 obj idx str))
        (defun autolabel:setblockattributevalue ( obj idx str ) (vla-setblockattributevalue   obj idx str))
    )
    (autolabel:setblockattributevalue obj idx str)
)

(defun autolabel:objectid ( obj )
    (if (vlax-property-available-p obj 'objectid32)
        (defun autolabel:objectid ( obj ) (vla-get-objectid32 obj))
        (defun autolabel:objectid ( obj ) (vla-get-objectid   obj))
    )
    (autolabel:objectid obj)
)

(defun autolabel:effectivename ( obj )
    (if (vlax-property-available-p obj 'effectivename)
        (defun autolabel:effectivename ( obj ) (strcase (vla-get-effectivename obj)))
        (defun autolabel:effectivename ( obj ) (strcase (vla-get-name obj)))
    )
    (autolabel:effectivename obj)
)

(defun autolabel:padzeros ( str len )
    (if (< (strlen str) len)
        (autolabel:padzeros (strcat "0" str) len)
        str
    )
)

(defun autolabel:disable ( key )
    (foreach grp (vlr-reactors :vlr-command-reactor :vlr-object-reactor)
        (foreach obj (cdr grp)
            (if (= key (vlr-data obj)) (vlr-remove obj))
        )
    )
    (setq autolabel:undoflag       nil
          autolabel:objectreactor  nil
          autolabel:commandreactor nil
    )
)

(defun autolabel:enable ( key )
    (autolabel:disable key)
    (vlr-set-notification
        (setq autolabel:objectreactor
            (vlr-object-reactor nil key
               '(
                    (:vlr-erased   . autolabel:objectreactorcallback:renumberblocks)
                    (:vlr-copied   . autolabel:objectreactorcallback:renumberblocks)
                    (:vlr-unerased . autolabel:objectreactorcallback:renumberblocks)
                )
            )
        )
        'active-document-only
    )
    (vlr-set-notification
        (vlr-command-reactor key
           '(
                (:vlr-commandwillstart . autolabel:commandreactorcallback:undocheck)
                (:vlr-commandended     . autolabel:commandreactorcallback:blockinserted)
            )
        )
        'active-document-only
    )
    (autolabel:commandreactorcallback:renumberblocks nil nil)
    (princ
        (strcat
            "\nAutonumbering enabled for tags matching \""
            autolabel:blocktag
            "\" within "
            (if (= 1 (logand 1 autolabel:objtype)) "blocks" "")
            (if (= 3 (logand 3 autolabel:objtype)) " & " "")
            (if (= 2 (logand 2 autolabel:objtype)) "multileaders" "")
            " matching \""
            autolabel:blockname
            "\"."
        )
    )
    (princ)
)

;;----------------------------------------------------------------------;;
;;                         Loading Expressions                          ;;
;;----------------------------------------------------------------------;;

(   (lambda nil
        (vl-load-com)
        (cond
            (   (vl-some
                    (function
                        (lambda ( val par )
                            (if (/= 'str (type val))
                                (princ (strcat "\nThe " par " parameter must be a valid string."))
                            )
                        )
                    )
                    (list
                        autolabel:blockname
                        autolabel:blocktag
                        autolabel:prefix
                        autolabel:suffix
                    )
                   '(
                        "Block Name"
                        "Attribute Tag"
                        "Numbering Prefix"
                        "Numbering Suffix"
                    )
                )
            )
            (   (/= 'int (type autolabel:start))
                (princ "\nThe Starting Number parameter must hold an integer value.")
            )
            (   (/= 'int (type autolabel:length))
                (princ "\nThe Fixed Length Numbering parameter must hold an integer value.")
            )
            (   (not
                    (and
                        (= 'int (type autolabel:objtype))
                        (< 0 autolabel:objtype)
                        (< 0 (logand 3 autolabel:objtype))
                    )
                )
                (princ "\nThe Object Type parameter must hold a bit-coded integer value between 1 & 3.")
            )
            (   (setq autolabel:blockname (strcase autolabel:blockname)
                      autolabel:blocktag  (strcase autolabel:blocktag)
                )
                (defun c:autolabelon nil
                    (autolabel:enable "autolabel")
                )
                (defun c:autolabeloff nil
                    (autolabel:disable "autolabel")
                    (princ "\nAutonumbering disabled.")
                    (princ)
                )
                (if autolabel:startup (autolabel:enable "autolabel"))
            )
        )
        (princ)
    )
)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

Howard Walker
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

EESignature


Left Handed and Proud

0 Likes
Reply
Accepted solutions (1)
1,075 Views
16 Replies
Replies (16)

MrJSmith
Advocate
Advocate

The answers to your questions are yes and yes. However, I don't understand the problem enough to implement....what exactly are you trying to do? I am assuming you want his script modified with your changes?

 

Do you want the script to put your characters after the "-" in the layout into the block? If so, why do you care if the suffix could be increment? Or you want these to be two separate options?

0 Likes

h_s_walker
Mentor
Mentor

@MrJSmith 

Ok so I have a block which is just a frame to hold a photo. At the moment it has a field code to read from a certain character in a layout name eg A2_1234-56(It will read 56)

Now we put quite a few photos on our drawings.

The first one is labelled P56a, the second P56b, the third P56c, and so on

At the moment the P56a is automatic, but we have to change the a to b and c and so on.

If Lee's code could be made to read the characters after a dash in the layout name and increment by letter instead of number is what I'm looking for

Howard Walker
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

EESignature


Left Handed and Proud

0 Likes

Sea-Haven
Mentor
Mentor

No code but you can look at the character number (chr 65) = "A", (chr 97) = "a" so if you use a (chr X) you can do (setq x (1+ x)) start with x=97. The (chr x) is supported in say (strcat "ABC-P" (chr x) )

 

If need to find a character number (ascii (getstring "\nenter single character "))

0 Likes

h_s_walker
Mentor
Mentor

@Sea-Haven apart from knowing the ascii code for the letters, what you have written is gobbledygook to me. I know nothing about lisp

Howard Walker
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

EESignature


Left Handed and Proud

0 Likes

Moshe-A
Mentor
Mentor

@h_s_walker hi,

 

Post a sample dwg so we will understand what you are talking about?

 

Moshe

 

0 Likes

h_s_walker
Mentor
Mentor

@Moshe-A Drawing attached

Howard Walker
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

EESignature


Left Handed and Proud

0 Likes

Sea-Haven
Mentor
Mentor

Just to explain a little more every key on your keyboard has a code, in the case of alphabet there are 52 codes as we have upper and lower case letters. We can also use in code common keys by a number such as comma and space. 

 

Just copy these 4 lines to the command line.

 

(setq x 64)
(repeat 26
(princ (strcat "\n" (chr (setq x (1+ x)))))
)

 

 

0 Likes

h_s_walker
Mentor
Mentor

@Sea-Haven I know all about ascii codes. What I do not know lisp. 

You put a lisp code in front of me and I don't know how to write it at all

Howard Walker
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

EESignature


Left Handed and Proud

0 Likes

ec-cad
Advocate
Advocate

You say "I know all about ascii codes. What I do not know lisp. 

You put a lisp code in front of me and I don't know how to write it at all"

 

How can that be if you have 5859 Posts (here at Visual LISP and AutoLisp.. Forum)

and 959 Solutions.

Surely you have (some) Lisp knowledge !

 

ECCAD

 

0 Likes

ec-cad
Advocate
Advocate

Study this one. It shows how to form those BlockNames.

(defun C:GO ()
  (setq CLayout "A2_1234_56")
  (setq Laynum (substr CLayout (- (strlen CLayout) 1) 2)); returns "56"

;;Then, to form consecutive BlockNames.
;; Testing

  (setq Prefix "P" x 97); set Letter Prefix & Starting Alpha Character to 'a', 65 = 'A'

;; To Get the NumberofBlocks do:
;;;;     (setq ss (ssget "X" (list (cons 410 (getvar "ctab"))(cons 0 "INSERT"))))
;;;;     (if ss (setq NumberofBlocks (sslength ss)))

;; Testing, remove if using above to get # Blocks
  (setq NumberofBlocks 20)

 (repeat NumberofBlocks
  (setq Suffix (chr x))
  (setq BlockName (strcat Prefix Laynum Suffix)); form Block Name
  (setq x (+ x 1))

;; Testing, Show at Textscreen what it did
  (princ "\n")
  (princ (strcat "\nBlockName = " BlockName))
  (princ)
;; 
;; Here, use the BlockName to rename the existing Block(s)
;;

 ); repeat

  (princ)
  (textscr); remove for final

); function C:GO
(C:GO)

;; Note: IF you have more than 26 different BlockNames, then this will not work
;;  as expected.

 

ECCAD

0 Likes

h_s_walker
Mentor
Mentor

It's not the blocks that I want to rename. It's the attribute that I want to change.

If you open the drawing I posted you'll see what I mean

Howard Walker
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

EESignature


Left Handed and Proud

0 Likes

ec-cad
Advocate
Advocate

Missed the original Post: You want to change the value of the Attribute "PHREF"

Here's a quick one. Attributes changed, based on order of inserts. No Reactors.

Needs a routine to 'sort' those Top to Bottom, and Left to Right.

I'll leave that to someone that has the time.

Checks for only Blockname 'PHOTOFRAME' - not 'OLD PHOTOFRAME' as in your example.

 

(defun C:GO ()
;; Reverse a Selection Set -- By: John Uhden, Cadlantic, 03-21-2002
 (defun reverse_ss (old / i new)
  (setq new (ssadd) i (sslength old))
  (while (> i 0)
   (ssadd (ssname old (setq i (1- i))) new))
 ); function

;; Get last few characters of current Tab (just past the "-" character)
  (setq CLayout (getvar 'ctab))
  (if CLayout
   (progn
    (setq N 1 TabNum "XXX"); Index, Default Tab Number - typical 2 or 3 character #
    (repeat (strlen CLayout)
     (setq ch (substr CLayout N 1))
      (if (= ch "-")
       (setq TabNum (substr CLayout (+ N 1))); last few characters
      ); if
     (setq N (+ N 1))
    ); repeat
   ); progn
  ); if

;; Set Prefix Letter, and ascii start point
  (setq Prefix "P" x 97 N 0); set Letter Prefix & Starting Alpha Character to 97 = 'a', 65 = 'A'

;; Get a Selection Set of Blockname "PHOTOFRAME"
  (setq ss (ssget "X" (list (cons 410 (getvar "ctab"))(cons 2 "PHOTOFRAME")(cons 0 "INSERT"))))
  (if ss
   (progn
    (setq ss (reverse_ss ss))
;; Get each Block, and change the Attribute Value with TagName "PHREF"
    (repeat (sslength ss)
     (setq Suffix (chr x))
     (setq Attvalue (strcat Prefix TabNum Suffix)); form Block Name
     (setq x (+ x 1))
     (setq blk (vlax-ename->vla-object (ssname ss N)))
       (if (safearray-value (setq atts (vlax-variant-value (vla-getattributes blk))))
        (progn
         (setq atts (vlax-safearray->list (vlax-variant-value (vla-getattributes blk))))
          (foreach att atts
           (setq Tag (vla-get-tagstring att))
             (if (and (/= Attvalue "")(= Tag "PHREF"))
              (vla-put-textstring att Attvalue)
             ); if
           ); foreach
         ); progn
        ); if
      (setq N (+ N 1))
 
;; Testing, Show at Textscreen what it did
      (princ "\n")
      (princ (strcat "\nAttvalue = " Attvalue))
      (princ "\n")
      (princ)
   ); progn
  ); if
 ); repeat

  (princ)
  (textscr); remove for final

); function C:GO
(C:GO)

;; Note: IF you have more than 26 different BlockNames, then this will not work
;;  as expected.

 

ECCAD

0 Likes

h_s_walker
Mentor
Mentor

@ec-cad my posts are mainly LT and dynamic blocks. My company has always used LT so there was never any need to use lisp.

Also thank you for trying to help, but Lee Mac's  lisp code I posted is almost exactly what I need

Howard Walker
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

EESignature


Left Handed and Proud

0 Likes

ec-cad
Advocate
Advocate

OK,

Here's my thoughts on that.

I (will not) edit / modify the original Author's code, when there's a Copyright applied.

You could send a request to Mr. MAC to make a modification to the code.

 

Did you even try the program I posted ?

It does exactly what you wanted.

 

ECCAD

0 Likes

h_s_walker
Mentor
Mentor
Accepted solution

Thanks to the help of @ec-cad it's now been solved.

Howard Walker
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

EESignature


Left Handed and Proud

0 Likes

ec-cad
Advocate
Advocate

Glad to help out.

Cheers!

PM me if you need any other assist.

 

ECCAD

0 Likes