Update code - Renamber Attribute Block Tags

December 20, 2023

Hi, I am using this code to renumber Attribute Block emply Tags (with no number). This code works fine in Autocad. I use ZWCAD now and getpropertyvalue is not supported. Is any other way to make this lisp work?

(defun c:ptxt (/ x i ss tag) 
 (vl-load-com)
 (setq x (getstring "\nGive Prefix <enter for nothing>: "))
 (setq i (getint "\nGive the start number:"))
 (if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
      (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
       (if (and (setq tag (getpropertyvalue blk "POINT")) (eq "" tag)) ;if block has point attribuet and its blank
        (progn
          (setpropertyvalue blk "POINT" (strcat x (rtos i 2 0)))
          (setq i (1+ i))
        )
(princ "No empty Attribute found") 
      )
    )
  )
(princ)
)

Thanks

December 20, 2023

Will any of these help?

http://www.lee-mac.com/attributefunctions.html

December 20, 2023

Hi , Steven P. No the code in the link not help. Is any way to change getpropertyvalue with another command?

Thanks

December 20, 2023

What about this one?

A couple of other options in the linked thread too

;;https://www.cadtutor.net/forum/topic/70636-get-tag-prompt-value-of-block-attributes/
(defun GetAtt (/ b ls_prt ls_tag ls_val)
  (if (setq b (entsel "\nSelect block: "))
    (progn
      (setq b (vlax-ename->vla-object (car b)))
      (if (= (vla-get-objectname b) "AcDbBlockReference")
        (progn
          (vlax-for item (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-name b))
            (if (= (vla-get-objectname item) "AcDbAttributeDefinition")
              (setq  ls_prt (cons (vla-get-promptstring item) ls_prt) ;;PROMPT List
                     ls_tag (cons (vla-get-tagstring    item) ls_tag) ;;TAG List
                     ls_val (cons (vla-get-textstring   item) ls_val) ;;VALUE List
;;                   Other block attribute properties...
              )
            )
          )
          (if ls_prt (list ls_prt ls_tag ls_val)(prompt "\nSelected block has no attributes."))
        )
        (prompt "\nSelected entity is not block.")
      )
    )
    (prompt "\nNothing selected.")
  )
) ;;GetAtt

December 20, 2023

I try to use a part of BIGAL code but is not working as I expect. Don't insert the text in the block tag.

;; From BIGAL
(defun aH:getatt (blk tagn / atts str)
(setq atts (vlax-invoke (vlax-ename->vla-object blk) 'getattributes))
(foreach att atts
(if (= (vla-get-tagstring att) tagn)
(setq str (vla-get-textstring att))
)
)
str
)


(defun c:foo (/ x i ss tag) 
 (vl-load-com)
 (setq x (getstring "\nGive Prefix <enter for nothing>: "))
 (setq i (getint "\nGive the start number:"))
 (if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
      (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      ; (if (and (setq tag (getpropertyvalue blk "POINT")) (eq "" tag)) ;if block has point attribuet and its blank
	  (if (and (setq tag (ah:getatt blk "POINT")) (eq "" tag))
        (progn
          (setpropertyvalue blk "POINT" (strcat x (rtos i 2 0)))
          (setq i (1+ i))
        )
(princ "No empty Attribute found") 
      )
    )
  )
(princ)
)

I think that in setpropertyvalue is the problem.

Any ideas?

Thanks

December 20, 2023

I have a very old vanilla code for get & set attribute value. Maybe it helps , I haven't tested it. Append code below in your lisp and change getpropertyvalue to _getpropertyvalue , same for setpopertyvalue.

(defun _setpropertyvalue ( %bn %an %nv / ss enr-blk enr-att found dat-att tag-naam)
  (cond
    ((equal (type %bn) 'str)
     (if (setq ss (ssget "X" (list (cons 0 "INSERT")(cons 2 %bn))))
       (setq enr-blk (ssname ss 0))))
     ((equal (type %bn) 'ename) (setq enr-blk %bn)))
  (if enr-blk
    (progn
      (setq found '() enr-att (entnext enr-blk))
      (while (and enr-att (not found))
	(setq dat-att (entget enr-att))
	(if (and (= (cdr (assoc 0 dat-att)) "ATTRIB")
		 (= (setq tag-naam (strcase (cdr (assoc 2 dat-att))))
		    (strcase %an)))
	  (progn
	    (setq found t)
	    (command-s "attedit" "y" "*" "*" "*" enr-att "v" "r"
		     %nv "")(entupd enr-blk))
	  (setq enr-att (entnext enr-att)))))
    (progn (princ "\nBlock not found ") (princ %bn))
  )
)

(defun _getpropertyvalue ( %blok-naam %attribuut-naam / zoek-blok blok-enr gevonden
             attribuut-enr attribuut-record tag-naam)
 (if (= (type %blok-naam) 'str)
  (if (setq zoek-blok (ssget "X" (list (cons 0 "INSERT")(cons 2 %blok-naam))))
   (setq blok-enr (ssname zoek-blok 0)))
  (setq blok-enr %blok-naam))
 (setq gevonden '())(if blok-enr (setq attribuut-enr (entnext blok-enr)))
 (while (and attribuut-enr (not gevonden))
  (setq attribuut-record (entget attribuut-enr))
  (if (and (= (cdr (assoc 0 attribuut-record)) "ATTRIB")
           (= (setq tag-naam (cdr (assoc 2 attribuut-record)))
                    (strcase %attribuut-naam)))
   (setq gevonden t)
   (setq attribuut-enr (entnext attribuut-enr))
  )
 )
 (if gevonden
  (setq inhoud (cdr (assoc 1 attribuut-record))) (setq inhoud '()))
)

December 20, 2023

When you look at GETATT or any other Vl posted you have 2 choices GET or PUT, its that simple.

(setq str (vla-get-textstring att))

(vla-put-textstring att newstring) ; your number

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq str (vlax-get att 'textstring))

(vlax-put att 'Textstring newstring) ; your number

Edit GETATT to suit.

December 21, 2023

Can anyone fix the code?

Thanks

December 21, 2023

I did all the changes but is not working. Any other ideas?

I attach a test.dwg

(defun c:foo (/ x i ss tag) 
 (vl-load-com)
 (setq x (getstring "\nGive Prefix <enter for nothing>: "))
 (setq i (getint "\nGive the start number:"))
 (if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
      (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
       (if (and (setq tag (_getpropertyvalue blk "POINT")) (eq "" tag)) ;if block has point attribuet and its blank
        (progn
          (_setpropertyvalue blk "POINT" (strcat x (rtos i 2 0)))
          (setq i (1+ i))
        )
(princ "No empty Attribute found") 
      )
    )
  )
(princ)
)


(defun _setpropertyvalue ( %bn %an %nv / ss enr-blk enr-att found dat-att tag-naam)
  (cond
    ((equal (type %bn) 'str)
     (if (setq ss (ssget "X" (list (cons 0 "INSERT")(cons 2 %bn))))
       (setq enr-blk (ssname ss 0))))
     ((equal (type %bn) 'ename) (setq enr-blk %bn)))
  (if enr-blk
    (progn
      (setq found '() enr-att (entnext enr-blk))
      (while (and enr-att (not found))
	(setq dat-att (entget enr-att))
	(if (and (= (cdr (assoc 0 dat-att)) "ATTRIB")
		 (= (setq tag-naam (strcase (cdr (assoc 2 dat-att))))
		    (strcase %an)))
	  (progn
	    (setq found t)
	    (command-s "attedit" "y" "*" "*" "*" enr-att "v" "r"
		     %nv "")(entupd enr-blk))
	  (setq enr-att (entnext enr-att)))))
    (progn (princ "\nBlock not found ") (princ %bn))
  )
)

(defun _getpropertyvalue ( %blok-naam %attribuut-naam / zoek-blok blok-enr gevonden
             attribuut-enr attribuut-record tag-naam)
 (if (= (type %blok-naam) 'str)
  (if (setq zoek-blok (ssget "X" (list (cons 0 "INSERT")(cons 2 %blok-naam))))
   (setq blok-enr (ssname zoek-blok 0)))
  (setq blok-enr %blok-naam))
 (setq gevonden '())(if blok-enr (setq attribuut-enr (entnext blok-enr)))
 (while (and attribuut-enr (not gevonden))
  (setq attribuut-record (entget attribuut-enr))
  (if (and (= (cdr (assoc 0 attribuut-record)) "ATTRIB")
           (= (setq tag-naam (cdr (assoc 2 attribuut-record)))
                    (strcase %attribuut-naam)))
   (setq gevonden t)
   (setq attribuut-enr (entnext attribuut-enr))
  )
 )
 (if gevonden
  (setq inhoud (cdr (assoc 1 attribuut-record))) (setq inhoud '()))
)

Thanks

test.dwg

December 21, 2023

Just redid it all

(defun aH:putatt (blk newstr str / att atts str)
(setq atts (vlax-invoke blk 'getattributes))
(foreach att atts
(if (= (vla-get-tagstring att) "POINT")
(vla-put-textstring att (strcat str (rtos newstr 2 0) ))
)
)
(princ)
)


(defun c:foo (/ x i ss tag str obj) 
(vl-load-com)
(setq str (getstring "\nGive Prefix <enter for nothing>: "))
(setq i (getint "\nGive the start number:"))
(if (setq ss (ssget '((0 . "INSERT")(2 . "point") (66 . 1))))
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(ah:putatt obj i str)
(setq i (1+ i))
)
(princ "No empty Attribute found") 
)
(princ)
)

December 22, 2023

Hi Bigal, thanks for the reply. The last code you post is not working like the first. In the first post the code insert the number in the block by the clicking order. In your code the last clicking block takes the number 1 (if I start with 1). Can you fix this ?

Thanks

December 22, 2023

Give this UNTESTED codes a go then let me know how you get on with it.

(defun c:Test (/ pre num sel int ent get fnd)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and
    (setq pre (getstring "\nSpecify Prefix value < Enter to none > : "))
    (setq num (getint "\nSpecify initial number : "))
    (princ "\nSelect attributed blocks to process : ")
    (setq int -1
          sel (ssget '((0 . "INSERT") (66 . 1)))
    )
    (while (setq int (1+ int)
                 ent (ssname sel int)
           )
      (while
        (and (not fnd)
             (not (eq (cdr (assoc 0 (setq get (entget (setq ent (entnext ent)))))) "SEQEND"))
        )
         (and (= (cdr (assoc 2 get)) "POINT")
              (= (cdr (assoc 1 get)) "")
              (entmod
                (subst (cons 1 (strcat pre (itoa num))) (assoc 1 get) get)
              )
              (setq num (1+ num)
                    fnd num
              )
         )
      )
      (setq fnd nil)
    )
  )
  (princ)
)

Edited December 22, 2023 by Tharwat

December 22, 2023

Hi Tharwat. I test the code , but when I select the blocks ZWCAD crash .......... not responded .... I don't know why.

Thanks

December 22, 2023

Did the program throw any message on the command line ?

December 22, 2023

No. Only with this code just crash. Allow to select the block , say that select a number of blocks and then crash

December 22, 2023

Try the program in AutoCAD.

December 22, 2023

I don't have Autocad any more

December 22, 2023

Sorry, the problem was with the iteration in the block definition.

Codes updated above.

December 22, 2023

Thanks Tharwat. I find this code.

(defun c:foo () :Attribute SeQuential numbering
(setq pre (getstring "\nGive Prefix <enter for nothing>: "))
(princ "\nGive the start number:")
(setq startnum (getint))
(setq num startnum)
(princ "\nSelect Block: ")
(while
(setq a (entsel))
(setq b (car a))
(setq c (entget b))
(setq d (entnext b))
(setq e (entget d))
(setq f (assoc 0 e))
(setq g (assoc 2 e))
(setq h (assoc 1 e))
(setq num$ (strcat pre (itoa num)))
(setq hh (cons 1 num$))
(setq e (subst hh h e))
(entmod e)
(entupd d)
(setq num (1+ num))
(princ "\nNext block: ")
)
(princ)
)

December 23, 2023

9 hours ago, mhy3sx said:

Thanks Tharwat. I find this code.

I expected you to test the program at least as a matter of respect that I invested for you for nothing but apparently you don't care so why do we ?

Sign In

Update code - Renamber Attribute Block Tags

Recommended Posts

mhy3sx

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

BIGAL

Tharwat

Steven P

mhy3sx

Steven P

mhy3sx

rlx

BIGAL

mhy3sx

mhy3sx

BIGAL

mhy3sx

Tharwat

mhy3sx

Tharwat

mhy3sx

Tharwat

mhy3sx

Tharwat

mhy3sx

Tharwat

Join the conversation

BIGAL

Tharwat

Tutorials

Forums

Activity