Blocks Auto Numbering Program LSP

[tusha13]

Hi everyone, I asked chatgpt to generate code for me that does the next - I need the command that will ask the user to enter a number of digits and increment value. After giving this information user should click on blocks' names one by one. A number of digits are an argument for how many digits of the attribute name from the end should change. For example, we have two blocks - 1DDS1.23 and 2DDS1.53. If the user enters the number of digits value "2" - the first block it clicks becomes 1DDS1.01 or 2DDS1.01(whichever is clicked first).  If the user enters the number "1" - the first block becomes 1DDS1.21 or 2DDS1.51. If the increment value is "1" every next block increments by 1. If you are familiar with "NUMINC" LSP, this program that I need is very similar, but the main difference is that I don't want to change the whole name, just the number of digits/symbols I enter. 

Here is the generated code below. I kept chatgpt guessing and checking bugs before it told me that it couldn't make this work  So, now I have only hope that someone can help me here. This final code that I have gives me the opportunity to enter both values and also click on several blocks, but nothing happens.

 

(defun c:NumberBlocks (/ numDigits increment current-number blk)
  ;; Get user input for the number of digits to change and the increment
  (setq numDigits (getint "\nEnter the number of digits to change: "))
  (setq increment (getint "\nEnter the increment value: "))

  ;; Initialize variables
  (setq current-number 1)

  ;; Loop to select blocks
  (while
    (and
      (setq blk (car (entsel "\nSelect a block or press ESC to exit: ")))
      (not (= blk "ESC")))
    ;; Number the selected block
    (setq current-number (+ current-number increment))
    (vl-catch-all-apply
      (function
        (lambda ()
          ;; Get the current block name
          (setq current-name (vla-get-Name (vlax-ename->vla-object blk)))

          ;; Extract the prefix and suffix
          (setq prefix (vl-string-left-trim numDigits current-name))
          (setq suffix (itoa current-number))

          ;; Create a new block name
          (setq new-name (strcat prefix "_" suffix))

          ;; Create a new block with the desired name
          (vla-put-Name (vla-get-BlockReferenceSpace (vla-get-ActiveDocument (vlax-get-acad-object))) new-name)
          (vla-InsertBlock (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-ename->vla-object blk) 1.0 1.0 1.0 0.0 new-name)
          
          ;; Erase the original block
          (vla-Erase (vlax-ename->vla-object blk))
        )
      )
    )
  )

  (princ "\nBlocks numbered successfully.")
  (princ)
)

 

[j2lstaples]

I'll respond to this problem by increments as I read your code. So, I'll update as soon as I can.

Also, please post a sample dwg with the blocks in question.

 

(setq current-name (vla-get-Name (vlax-ename->vla-object blk)))

This part might not work. It's better to use effective block name.

Something from Lee Mac would probably work. Especially for dynamic blocks.

;; Effective Block Name  -  Lee Mac
;; obj - [vla] VLA Block Reference object

(defun LM:effectivename (obj) 
  (vlax-get-property obj 
                     (if (vlax-property-available-p obj 'effectivename) 
                       'effectivename
                       'name
                     )
  )
)

 

 

 

 

[tusha13]

Thank you for your respoDrawing1.dwgnse. Here is a sample DWG.

[Steven P]

If this was modified to take away the dialogue box, do you think this would work? Command is RenB by AlanJT - he hasn't been on here for a couple of months though

 

 

;;https://www.cadtutor.net/forum/topic/46160-rename-block/
(defun c:RenB ( / )

(defun RenB (/ obj old new)
 ;; Rename Selected Block
 ;; Required Subroutines: AT:GeSel, AT:Getstring
 ;; Alan J. Thompson, 03.10.10 / 07.15.10
 (if
   (and
     (AT:GetSel
       entsel
       "\nSelect block to rename: "
       (lambda (x)
         (if
           (and (eq "INSERT" (cdr (assoc 0 (entget (car x)))))
                (/= 4
                    (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 (entget (car x))))))) 4)
                )
           )
            (setq obj (vlax-ename->vla-object (car x)))
         )
       )
     )

     (setq old (if (vlax-property-available-p obj 'effectivename)
                 (vla-get-effectivename obj)
                 (vla-get-name obj)
               )
     )
     (not (vl-position
            (setq new (AT:GetString "Specify new block name:" old))
            (list old "" nil)
          )
     )
   )
    (cond
      ((tblsearch "BLOCK" new) (alert (strcat "\"" new "\" already exists!")))
      ((not (snvalid new)) (alert (strcat "\"" new "\" is an invalid name!")))
      ((and (snvalid new) (not (tblsearch "block" new)))
       (if
         (vl-catch-all-error-p
           (vl-catch-all-apply
             'vla-put-name
             (list
               (vla-item (vla-get-blocks
                           (cond (*AcadDoc*)
                                 ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                           )
                         )
                         old
               )
               new
             )
           )
         )
          (alert (strcat "Block: " old " could not be renamed to: " new))
          (alert (strcat "Block: " old " renamed to: " new))
       )
      )
    )
 )
 (princ)
)



(defun AT:GetSel (meth msg fnc / ent)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (while
   (progn (setvar 'ERRNO 0)
          (setq ent (meth (cond (msg)
                                ("\nSelect object: ")
                          )
                    )
          )
          (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                ((eq (type (car ent)) 'ENAME)
                 (if (and fnc (not (fnc ent)))
                   (princ "\nInvalid object!")
                 )
                )
          )
   )
 )
 ent
)



(defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString)
 ;; Getstring Dialog Box
 ;; #Title - Title of dialog box
 ;; #Default - Default string within edit box
 ;; Alan J. Thompson, 08.25.09
 (setq #FileName (vl-filename-mktemp "" "" ".dcl")
       #FileOpen (open #FileName "W")
 )
 (foreach x '("TempEditBox : dialog {" "key = \"Title\";" "label = \"\";"
              "initial_focus = \"Edit\";" "spacer;" ": row {" ": column {" "alignment = centered;"
              "fixed_width = true;" ": text {" "label = \"\";" "}" "}" ": edit_box {"
              "key = \"Edit\";" "allow_accept = true;" "edit_width = 40;" "fixed_width = true;" "}"
              "}" "spacer;" ": row {" "fixed_width = true;" "alignment = centered;" ": ok_button {"
              "width = 11;" "}" ": cancel_button {" "width = 11;" "}" "}" "}//"
             )
   (write-line x #FileOpen)
 )
 (close #FileOpen)
 (setq #DclID (load_dialog #FileName))
 (new_dialog "TempEditBox" #DclID)
 (set_tile "Title" #Title)
 (set_tile "Edit" #Default)
 (action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)")
 (action_tile "cancel" "(done_dialog)")
 (start_dialog)
 (unload_dialog #DclID)
 (vl-file-delete #FileName)
 #NewString
)


(renB)

)

 

[Romero]

Below is a preliminary example. Please let me know if it fits your requirements.

;+1 increment in block with attribute
;The tag is defined by the user: "NAME"
;The user is asked the number of characters to go from right to left
;If the number of characters is less than those requested, an alert message is displayed but the code is not stopped
;[Copyright ©R0m3r014] romerocruz.ivan@gmail.com  diciembre 04 2023


(defun c:IAT( / IRtag IRss1 IRnumChars)
 (vl-load-com)
 (setq IRtag "NAME" 
       IRnumChars (getint "\nNUMBER OF CHARACTERS ONE SCROLL: ")
 )

 (if (setq *IRnum* (cond ( (getint (strcat "\nSTART NUMBER"  (if *IRnum* (strcat " <" (itoa *IRnum*) "> : ") ": ")))) ( *IRnum* )))
   (while (setq IRss1 (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1))))
     (foreach x (vlax-invoke (vlax-ename->vla-object (ssname IRss1 0)) 'getattributes)
       (if (eq IRtag (vla-get-tagstring x))
         (progn
           (setq IRoldText (vla-get-textstring x))
           (if (< (strlen IRoldText) IRnumChars)
             (alert "Error: Text does not have enough characters to loop.") 
             (progn
               (setq IRnewText (strcat (substr "0" 1 (- 2 (strlen (itoa *IRnum*)))) (itoa *IRnum*))) 
               (setq IRcombinedText (strcat (substr IRoldText 1 (- (strlen IRoldText) IRnumChars)) IRnewText))
               (vla-put-textstring x IRcombinedText)
               (setq *IRnum* (1+ *IRnum*))  
             )
           )
         )
       )
     )
   )
 )
 (princ)
)

 

[mhupp]

Just a little heads. If you are using these drawing in any type of production. its probably best to have additional information in the block name. like maybe the drawing name or something else to make them unique to that drawing. I had an auto block lisp that would look for the next available block name and create the next block. This lisp worked fine on its own but ended up wasted about a weeks worth of material and time. because we were moving blocks between two projects that where about 80% the same layout but minor changes changes between the two.

 

What am i talking about?

if you have two drawings and both have a block named "1DDS1.21" but in in drawing 1 its a 5" circle and in drawing 2 its a 3" circle.

 

if you copy anything from drawing 2 and paste into drawing 1 lines, text, any entity that isn't a block come over 1:1. With blocks it changes and defaults to the block definition of the drawing your pasting into. so you think your copying over (4) 3" circles but when you are pasting into drawing 1 they become (4) 5" circles. or if they could be the same block just the base point is different location. then they are not in the same location when pasting.

[tusha13]

Guys, thanks everyone for your response.

 

Romero, your code works properly. It alerts me when I click but does the job I need anyway.

 

Thank you so much, you helped me a lot,

Good luck.

[Romero]

On 12/4/2023 at 11:17 PM, tusha13 said:

Guys, thanks everyone for your response.

 

Romero, your code works properly. It alerts me when I click but does the job I need anyway.

 

Thank you so much, you helped me a lot,

Good luck.

 

I am very happy to know that the code worked correctly for you and that it managed to fulfill the purpose you needed. I appreciate your words and I am glad that I could be of help.