Jump to content

Incremental Numbering Lisp File


Curty123

Recommended Posts

I have hundreds of blocks that I need to number. Each bock has an attribute to renumbered. I want to have a lisp file that allows me to 1) select the blocks, 2) enter the attribute tag, 3) enter the start number, 4) enter the increment number 5) sort by x or y. Below is the start of the lisp file that ChatGPT helped me with but I cannot get it to run correctly and now seem to be going in circles. Any help would be greatly appreciated. 

 

 

(defun c:RenumberBlocks (/ ss att-tag start-num increment-num coordinate-option num current-value blk att curve pt)
  (vl-load-com)

  ; Step 1: Select the blocks
  (setq ss (ssget "_:L" '((0 . "INSERT"))))

  (if ss
      (progn
        ; Step 2: Ask for the attribute tag to renumber
        (setq att-tag (getstring "\nEnter the attribute tag to renumber: "))

        ; Step 3: Prompt user for starting number
        (setq start-num (getreal "\nEnter the starting number: "))

        ; Step 4: Prompt user for increment number
        (setq increment-num (getreal "\nEnter the increment number: "))

        ; Step 5: Choose to number by x or y coordinates
        (setq coordinate-option (getstring "\nEnter 'X' to number by X-coordinate, 'Y' to number by Y-coordinate: "))

        ; Renumbering loop
        (setq num start-num)
        (setq total-ss (sslength ss))
        (setq i 0)
        (while (< i total-ss)
          (setq ename (ssname ss i))
          (setq blk (vla-object (vlax-ename->vla-object ename))) ; Use vla-object directly on ename
          (setq att (vla-getattributes blk))
          (while att
            (if (equal (vla-get-tagstring att) att-tag)
              (progn
                ; Get the current attribute value
                (setq current-value (vla-gettextstring att))

                ; Determine the new attribute value based on the chosen coordinate
                (setq curve (vlax-ename->vla-object ename))
                (setq pt (if (= coordinate-option "X")
                             (vlax-curve-getstartpoint curve)
                             (vlax-curve-getstartpoint curve)))

                ; Set the new attribute value and increment the number
                (vla-puttextstring att (rtos num))
                (setq num (+ num increment-num))
              )
            )
            (setq att (vla-next att))
          )
          (setq i (1+ i))
        )

        (princ "\nBlocks renumbered successfully.")
      )
      (princ "\nNo blocks selected.")
  )

  (princ)
)

 

Edited by fuccaro
Adding CODE tags
Link to comment
Share on other sites

Like this:

 

Those first lines of the main function that asks for user input,  feel free to change the order of those lines  (per 2 or 3 lines)

 

You get an extra option: "X" is from left to right, "-X" is from right to left.  Dito for Y.

 

Command INC

and follow the instructions in the command line.

Test dwg as attachment

 

 

;; @FILE increment a selected attribute on multiple blocks, sorted by X or Y coordinate of the block insert.

(vl-load-com)

;; http://www.lee-mac.com/attributefunctions.html#alsetattributevaluerc
;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.
(defun LM:setattributevalue ( blk tag val / enx )
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx))
                (progn
                    (entupd blk)
                    val
                )
            )
            (LM:setattributevalue blk tag val)
        )
    )
)


(defun c:inc ( / sel i blkobj blockname start_inc val increase_by sort_by a sel_att x_coords y_coords sortedi blk ip)

;; FEEL FREE TO CHANGE THE ORDER OF THESE COMMANDS.
	;; start increment by number: 
	(setq start_inc (getint  "\nStart increment by number: "))
	
	;; increase by how much: 
	(setq increase_by (getint  "\nIncrease by how much: "))
	
	;; sort by X or Y?
	(setq sort_by (strcase (getstring "\nSort by X (left to right), Y (bottom to top) -X (right to left) or -Y (top to bottom) : ")))
	
	;; select attribute
	(setq a (nentsel "\nSelect attribute: "))
	(setq sel_att (cdr (assoc 2 (entget (car a)))))
	(setq blkobj (cdr (assoc 330 (entget (car a)))))		;; get the block
	(setq blockname (cdr (assoc 2 (entget blkobj))))		;; get the blockname
	
	(princ "\nBlock: ")
	(princ blockname)
	(princ " - attribute: ")
	(princ sel_att)
	

;;   Do this last.  We only know the blockname after we pick the attribute.
	
	;; select blocks
	(princ "\nSelect blocks: ")
	(setq sel (ssget (list (cons 0 "INSERT") (cons 2 blockname) )))
	
;;

	;; read coordinates of the blocks
	(setq i 0)
	(setq x_coords (list))
	(setq y_coords (list))
	
	(repeat (sslength sel)
		(setq blk (ssname sel i))
		(setq ip (cdr (assoc 10 (entget blk))))  ;; insert point
		(setq x_coords (append x_coords (list (nth 0 ip))))
		(setq y_coords (append y_coords (list (nth 1 ip))))
	
		(setq i (+ i 1))
	)

	
	(setq sortedi (list))
	;; sortedi will be the order of the blocks. 
	(if (= sort_by "X")
		(setq sortedi (vl-sort-i x_coords '<))
	)
	(if (= sort_by "-X")
		(setq sortedi (vl-sort-i x_coords '>))
	)
	(if (= sort_by "Y")
		(setq sortedi (vl-sort-i y_coords '<))
	)
	(if (= sort_by "-Y")
		(setq sortedi (vl-sort-i y_coords '>))
	)
	
	;; now loop over the blocks, in order of sortedi
	(setq val start_inc)
	(foreach i sortedi
		(setq blk (ssname sel i))
		(LM:setattributevalue blk sel_att (itoa val))
		;; increase
		(setq val (+ val increase_by))
	)
	
	(princ)
	
)

 

(Edited the code 13-12-2023)

 

increment_xy.dwg

Edited by Emmanuel Delay
  • Thanks 1
Link to comment
Share on other sites

  • 2 weeks later...

FYI...
ChatGBT does not do lisp well.

it can sometimes get you close but I have found personally a 85% failure rate.

It makes up functions. Sometimes it's funny what it calls them...

 

Sometimes it fills enough gaps so that if you know lisp you can fill in the needed parts.

 

I do hope it gets better...

 

  • Like 1
  • Agree 2
Link to comment
Share on other sites

ChatGPT was once explained to me that it is just a really clever predictive text algorithm, like on your phone messaging just a bit more advanced. It can't think for itself it just predicts the text to use. Similar to your phone you still have to compose what you want to say even if the phone fills in the blanks for the words to use.

  • Agree 1
Link to comment
Share on other sites

  • 1 month later...
On 12/12/2023 at 2:51 PM, Emmanuel Delay said:

Like this:

 

Those first lines of the main function that asks for user input,  feel free to change the order of those lines  (per 2 or 3 lines)

 

You get an extra option: "X" is from left to right, "-X" is from right to left.  Dito for Y.

 

Command INC

and follow the instructions in the command line.

Test dwg as attachment

 

 

;; @FILE increment a selected attribute on multiple blocks, sorted by X or Y coordinate of the block insert.

(vl-load-com)

;; http://www.lee-mac.com/attributefunctions.html#alsetattributevaluerc
;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.
(defun LM:setattributevalue ( blk tag val / enx )
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx))
                (progn
                    (entupd blk)
                    val
                )
            )
            (LM:setattributevalue blk tag val)
        )
    )
)


(defun c:inc ( / sel i blkobj blockname start_inc val increase_by sort_by a sel_att x_coords y_coords sortedi blk ip)

;; FEEL FREE TO CHANGE THE ORDER OF THESE COMMANDS.
	;; start increment by number: 
	(setq start_inc (getint  "\nStart increment by number: "))
	
	;; increase by how much: 
	(setq increase_by (getint  "\nIncrease by how much: "))
	
	;; sort by X or Y?
	(setq sort_by (strcase (getstring "\nSort by X (left to right), Y (bottom to top) -X (right to left) or -Y (top to bottom) : ")))
	
	;; select attribute
	(setq a (nentsel "\nSelect attribute: "))
	(setq sel_att (cdr (assoc 2 (entget (car a)))))
	(setq blkobj (cdr (assoc 330 (entget (car a)))))		;; get the block
	(setq blockname (cdr (assoc 2 (entget blkobj))))		;; get the blockname
	
	(princ "\nBlock: ")
	(princ blockname)
	(princ " - attribute: ")
	(princ sel_att)
	

;;   Do this last.  We only know the blockname after we pick the attribute.
	
	;; select blocks
	(princ "\nSelect blocks: ")
	(setq sel (ssget (list (cons 0 "INSERT") (cons 2 blockname) )))
	
;;

	;; read coordinates of the blocks
	(setq i 0)
	(setq x_coords (list))
	(setq y_coords (list))
	
	(repeat (sslength sel)
		(setq blk (ssname sel i))
		(setq ip (cdr (assoc 10 (entget blk))))  ;; insert point
		(setq x_coords (append x_coords (list (nth 0 ip))))
		(setq y_coords (append y_coords (list (nth 1 ip))))
	
		(setq i (+ i 1))
	)

	
	(setq sortedi (list))
	;; sortedi will be the order of the blocks. 
	(if (= sort_by "X")
		(setq sortedi (vl-sort-i x_coords '<))
	)
	(if (= sort_by "-X")
		(setq sortedi (vl-sort-i x_coords '>))
	)
	(if (= sort_by "Y")
		(setq sortedi (vl-sort-i y_coords '<))
	)
	(if (= sort_by "-Y")
		(setq sortedi (vl-sort-i y_coords '>))
	)
	
	;; now loop over the blocks, in order of sortedi
	(setq val start_inc)
	(foreach i sortedi
		(setq blk (ssname sel i))
		(LM:setattributevalue blk sel_att (itoa val))
		;; increase
		(setq val (+ val increase_by))
	)
	
	(princ)
	
)

 

(Edited the code 13-12-2023)

 

increment_xy.dwg 35.96 kB · 6 downloads

This works fine for standard blocks, but not for dynamic blocks.
Could you please modify it so that it also works for dynamic blocks?

Link to comment
Share on other sites

@Jozef13

;; Change this
(setq blockname (cdr (assoc 2 (entget blkobj))))
;; To this
(setq blockname (getpropertyvalue blkobj "BlockTableRecord/Name"))
;; Then change this
(setq sel (ssget (list (cons 0 "INSERT") (cons 2 blockname))))
;; To this
(if (setq sel (ssget (list '(0 . "INSERT") (cons 2 (strcat "`*U*," blockname)))))
  (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))
    (or (= blockname (getpropertyvalue e "BlockTableRecord/Name")) (ssdel e sel))
  )
)

 

  • Like 2
Link to comment
Share on other sites

7 hours ago, ronjonp said:

@Jozef13

;; Change this
(setq blockname (cdr (assoc 2 (entget blkobj))))
;; To this
(setq blockname (getpropertyvalue blkobj "BlockTableRecord/Name"))
;; Then change this
(setq sel (ssget (list (cons 0 "INSERT") (cons 2 blockname))))
;; To this
(if (setq sel (ssget (list '(0 . "INSERT") (cons 2 (strcat "`*U*," blockname)))))
  (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))
    (or (= blockname (getpropertyvalue e "BlockTableRecord/Name")) (ssdel e sel))
  )
)

 

Super, Thank you.👍

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...