Change attribute via lisp?

[nonifo]

Hello everyone,

As a newcomer to the forum, I'm reaching out for assistance on a task. I'm looking for guidance on efficiently updating attribute values in the provided file using Lisp. The block consistently bears the name EPCB000 and appears only once in each DWG file. Additionally, I'd appreciate insights on extracting values from the fields for targeted 'find and replace' operations. I'm grateful for any advice and examples you can share. Thank you in advance for your help.

Best regards,
Tony

Drawing1.dwg

[Steven P]

would this help?

 

https://lee-mac.com/macatt.html

[BIGAL]

What do you want to do maybe one of these.

 

Copy atts in block to all similar blocks in layouts, fill in one 1 block attributes and blocks are updated in all layouts.

Update sheet X of Y

Update 1 attribute in all blocks using a dcl to select

 

Please explain more.

 

Ps make an Index from title blocks.

Edited April 23 by BIGAL

[nonifo]

I have my block EPCB000, which is my title block. I want to change all the text inside this block to new text. The drawing is a copy of an electric cabinet, but it needs new text details as it's for a new customer.

Inside my block EPCB000, there are a few attributes: D12, D13, GODK_DAT, and so on. I want to update the value of those tags in bulk, and apply a few rules, such as using today's date. For example, if D12 holds the value "G11 This is a drawing", I want to update it to G12, and so on.

However, I can't figure out how to read and write to those values.

[BIGAL]

Ignore multiple dwg's for moment.

 

As you say only have title block once then its easy.

(setq ss (ssget "X" '((0 . "INSERT")(cons 2 "EPCB000"))))

You now have a selection set containing the block.

(setq obj (vlax-ename->vla-object (ssname ss 0)))
(setq atts (vlax-invoke obj 'Getattributes))

The variable atts holds all the attributes. You can then say change the value in each attribute, as you want to change many it makes it easy. You can just loop trough the attributes and change the "TEXTSTRING" the value of the attribute, you can also check for a particular attribute and say change G11 to G12.

 

Ok next question how do you propose to supply the new values ? One way is to make a list of the new values say keep the code in a lisp file and just change the 1 line with the new answers, or keep the values in a text file change it and then run on multiple dwg's if required. This is the type of question linked to excel  which can read say a row of details. The excel containing multiple dwg names.

 

 

 

 

 

[mhupp]

gatte command?

[nonifo]

On 4/27/2024 at 12:37 AM, BIGAL said:

Ignore multiple dwg's for moment.

 

As you say only have title block once then its easy.

(setq ss (ssget "X" '((0 . "INSERT")(cons 2 "EPCB000"))))

You now have a selection set containing the block.

(setq obj (vlax-ename->vla-object (ssname ss 0)))
(setq atts (vlax-invoke obj 'Getattributes))

The variable atts holds all the attributes. You can then say change the value in each attribute, as you want to change many it makes it easy. You can just loop trough the attributes and change the "TEXTSTRING" the value of the attribute, you can also check for a particular attribute and say change G11 to G12.

 

Ok next question how do you propose to supply the new values ? One way is to make a list of the new values say keep the code in a lisp file and just change the 1 line with the new answers, or keep the values in a text file change it and then run on multiple dwg's if required. This is the type of question linked to excel  which can read say a row of details. The excel containing multiple dwg names.

 

 

 

 

 

With use of ChatGPT I got this code to write to my tags value, and it works, almost. 
It can't handel UTF-8 (swedish charter like ÅÄÖ), any tip how to solve that? 

This code let me write to the value:

;; Function to convert UTF-8 to ANSI
(defun utf8-to-ansi (str)
  (vl-string-translate "\xC3\x84\xC3\x85\xC3\x96" "\x84\x85\x96" str)
)

;; Function to convert ANSI to UTF-8
(defun ansi-to-utf8 (str)
  (vl-string-translate "\x84\x85\x96" "\xC3\x84\xC3\x85\xC3\x96" str)
)

;; Set the coding system to UTF-8
(setq *coding-system* 'utf-8)

;; Retrieve all block references with type "INSERT" and name "EPCB000"
(setq ss (ssget "X" '((0 . "INSERT")(2 . "EPCB000"))))
(setq obj (vlax-ename->vla-object (ssname ss 0)))
(setq atts (vlax-invoke obj 'Getattributes))

;; Loop through the attributes and print their values
(while atts
  (setq att (car atts))
  (setq atts (cdr atts))
  (setq tag (vla-get-tagstring att))
  ;; Use utf8-to-ansi to convert character encoding
  (setq value (utf8-to-ansi (vla-get-textstring att)))
  ;; Check if the tag matches any of the attributes you want to update
  (cond
    ((equal tag "D8") (vla-put-textstring att (ansi-to-utf8 "ÅPA")))
    ((equal tag "D7") (vla-put-textstring att (ansi-to-utf8 "ÖPPNA")))
    ((equal tag "D6") (vla-put-textstring att (ansi-to-utf8 "STÄNG")))
  )
)

(princ) ; Display the message in the command prompt

 

 

This code let me read the tag and their value:

;; Function to read strings directly in UTF-8
(defun read-utf8-string (str)
  str
)

;; Set the coding system to UTF-8
(setq *coding-system* 'utf-8)

(setq ss (ssget "X" '((0 . "INSERT")(2 . "EPCB000"))))
(setq obj (vlax-ename->vla-object (ssname ss 0)))
(setq atts (vlax-invoke obj 'Getattributes))

;; Loop through the attributes and print their values
(while atts
  (setq att (car atts))
  (setq atts (cdr atts))
  ;; Use read-utf8-string to read strings directly in UTF-8
  (princ (strcat (read-utf8-string (vla-get-tagstring att)) ": " (read-utf8-string (vla-get-textstring att)) "\n"))
)

(princ) ; Display the message in the command prompt

 

[Steven P]

I think this is kind of what you are trying to do:

It might do odd things if the block has 2 tags with the same name

 

 

I've split this into 2 parts, the block updating part (UpdateBlock) which might be a useful one to have that can be used for several functions and test. Test is a dotted pair list, 'tag name . text string', I find this way easier to updated. You might be want a little function that can generate all this from a few user inputs or a dialog box.

Note the first line of the list

(cons "C2" "Project Name") ;; Project name

is how you want it to be if the list is created via LISP otherwise the other format is OK if you edit the LISP file. I'd also add the note "Project Name" at the end of each to remind yourself what each line does

 

 

Swedish characters: If they are in the character set used in the block then it should work OK - tested with Å

 

 

(defun c:test ( / NewTitles )
  ;;Tag Name : New Text
  (setq NewTitles (list ; create a list of block tags and their values
    (cons "C2" "Project Name") ;; Project Name
    '( "D3" . "Object Name")
    '( "D4" . "Function")
    '( "D12" . "File Name")
    '( "C10" . "Number")
    '( "D13" . "Another Number")
    '( "C11" . "Construction")
    '( "D6" . "ÅÅ")
    '( "D7" . "Date")
    '( "BLAD" . "Blad")
    '( "D10" . "Revision")
    '( "D25" . "Forts Blad")
  )) ; end list ; end setq
  (UpDateBlock NewTitles) ; use this list in 'UpDateBlock' function
  (princ) ; exit quietly
)
(defun UpdateBlock ( NewTitles / ss obj atts att tag NewText)
  ;; Retrieve all block references with type "INSERT" and name "EPCB000"
  (setq ss (ssget "X" '((2 . "EPCB000"))))          ; find the title block (here no need for (1 . "INSERT") )
  (setq obj (vlax-ename->vla-object (ssname ss 0))) ; Get title block as VLA- object
  (setq atts (vlax-invoke obj 'Getattributes))      ; List the VLA- tags / attributes names

  (foreach att atts                                 ; Loops through tags / attributes
    (setq tag (vla-get-tagstring att))              ; Get the 'real' tag name
    (setq NewText (assoc tag NewTitles))            ; Find tag dotted pair in the supplied list
    (if (= Newtext nil)                             ; Check if the tag is in the supplied list
      (progn
        (princ "\nTag: ")(princ tag)(princ ", ")(princ (vla-get-textstring att)(princ " not updated") ; report if the tag wasn't updated
      ) ; end progn
      (progn
        (setq NewText (cdr NewText))                    ; get the new tag value
        (vla-put-textstring att NewText)              ; update the tag
      ) ; end progn
    ) ; end if
  ) ; end foreach
)

 

 

EDIT:

Apologies if my translation in the list isn't quite what the tags mean in English.

Edited April 29 by Steven P

[nonifo]

Well, i cant get it to work with your code. But this code almost work.

I want to input my text in the file, like setup a variable. 
Then i want the script to change every ÅÄÖåäö in the text to corresponding "code" \\U+00C5 for the sign Å for example. But i cant get it to find it in the text string, but if is the only sign in the input, it works perfectly. 

 

(defun UpdateBlock (NewTitles / ss obj atts att tag NewText tagUpdated)
  ;; Retrieve all block references with type "INSERT" and name "EPCB000"
  (setq ss (ssget "X" '((2 . "EPCB000"))))          ; find the title block (here no need for (1 . "INSERT") )
  (setq obj (vlax-ename->vla-object (ssname ss 0))) ; Get title block as VLA- object
  (setq atts (vlax-invoke obj 'Getattributes))      ; List the VLA- tags / attributes names

  (setq tagUpdated nil) ; Initialize variable to track if any tag has been updated

  (foreach att atts                                 ; Loops through tags / attributes
    (setq tag (vla-get-tagstring att))              ; Get the 'real' tag name
    (setq NewText (assoc tag NewTitles))            ; Find tag dotted pair in the supplied list
    (if (= NewText nil)                             ; Check if the tag is in the supplied list
        (progn
          (princ "\nTag: ")(princ tag)(princ ", ")(princ (vla-get-textstring att))(princ " not updated")) ; report if the tag wasn't updated
        (progn
          (setq NewText (cdr NewText))                    ; get the new tag value
          (vla-put-textstring att NewText)                ; update the tag
          (setq tagUpdated t)                             ; set flag to indicate tag has been updated
      ) ; end progn
    ) ; end if
  ) ; end foreach

  ;; Set tagUpdated to T if any tag has been updated
  (setq tagUpdated T)

  ;; Print message only if no tags have been updated
  (if (not tagUpdated)
    (princ "\nAll tags updated successfully.")
  )
) ; end UpdateBlock



;;Tag Name : New Text
(setq NewTitles (list ; create a list of block tags and their values
                    (cons "C2" "KRAFTSTATION") ;; Project Name
                    '( "GODK_DAT." . "24.04.29")
                    '( "GODK_AV" . "Å")
                    '( "GRANSK_AV" . "Ä")
                    '( "RITAD_AV" . "Ö")
                    '( "D13" . "å")
                    '( "D14" . "ä")
                    '( "D5" . "ställverk Dist. I/O, Sut")
                    '( "D4" . "ö")
                    '( "D8" . "åäö")
                    '( "D7" . "24.04.29")
                    '( "D6" . "ÅÄÖ")
                    '( "C10" . "561")
                    )) ; end list ; end setq

(UpdateBlock NewTitles) ; use this list in 'UpdateBlock' function
(princ) ; exit quietly

 

[BIGAL]

I have done something similar where you select block and its tag and current value are displayed in a dcl so you edit and it makes a list of all attributes, the update of the block ignores tag names rather updates based on attribute order so actually updates all attributes. The dcl code uses my Multi getvals.lsp so that is done.

 

As you want to do multi dwg it needs to be a 2 step process select block and do edits then save in say a file, then run across multiple dwg's reading the file for values. Going further blank out values then can set those to not update they have a value of "".

 

This example is pushing the screen size as it has 25 attributes. You just edit the attribute values. 

 

 

(defun getatttagnames (obj / )
(setq lst '())
(setq atts (vlax-invoke obj 'getattributes))
(foreach att atts
(setq lst (append (list (vla-get-textstring att) 29 30 (vla-get-tagstring att) )  lst) )
)
)

(defun wow ( / ss lst obj att atts str)
(setq ss (ssget "x" '((0 . "INSERT")(2 . "EPCB000"))))
(setq obj (vlax-ename->vla-object (ssname ss 0)))
(getatttagnames obj)

(setq lst (reverse lst))
(setq lst (cons "Please edit" lst))

(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans (AH:getvalsm lst))

(setq x -1)
(foreach att atts
(setq str (nth (setq x (1+ x)) ans))
(if (= str "")
  (princ)
  (vla-put-textstring att str)
)
)

(princ)
)
(wow)

 

PS there is a line spacer in the dcl code so I think somewhere did a version when you have lots of rows it is left out. Line 33 in multi getvals.

 

 

Multi GETVALS.lsp

 

 

 

 

Edited May 7 by BIGAL

[nonifo]

Finally, i success to do my thing Need to share my code with you if someone else need the inspiration of doing something lookalike. 

 

 

;; Version 0.1
;;      First version
;; Version 0.2
;;      Minor adjustments
;; Version 0.3
;;      Added Zoom -e

;; Tidy up zoom before we do anything else
(command "._zoom" "e")

(defun c:getFormattedDate ()
  (setq today (rtos (getvar "CDATE") 2 0))
  (setq year (substr today 3 2))
  (setq month (substr today 5 2))
  (setq day (substr today 7 2))
  (strcat year "." month "." day)
)

;; Create the date string
(setq currentDate (c:getFormattedDate))

(defun c:getFileNameNoExtension ()
  (setq fullFileName (getvar "DWGNAME"))       ; Get the full file name with extension
  (setq fileName (vl-filename-base fullFileName)) ; Remove path and file extension

  ; Search for the position of the first underscore and trim the file name from there
  (setq pos (vl-string-search "_" fileName))
  (if pos
    (setq fileName (substr fileName 1 pos)) ; If underscore exists, take only the part before _
  )

  fileName                                      ; Return the modified file name
)
;; Create the drawing number string
(setq drawingName (c:getFileNameNoExtension))


(defun c:getBoxName ()
  ;; Get the full file name with extension
  (setq fullFileName (getvar "DWGNAME"))

  ;; Remove path and file extension
  (setq fileName (vl-filename-base fullFileName))

  ;; Search for the position of the last hyphen
  (setq lastHyphenPos nil)
  (setq i 1)
  (while (setq pos (vl-string-search "-" fileName i))
    (setq lastHyphenPos pos)
    (setq i (+ pos 1))
  )

  ;; Search for the position of the first underscore
  (setq firstUnderscorePos (vl-string-search "_" fileName))

  ;; Check if both positions are found
  (if (and lastHyphenPos firstUnderscorePos)
    ;; Extract the substring between the hyphen and the underscore
    (setq boxName (substr fileName (+ lastHyphenPos 2) (- firstUnderscorePos lastHyphenPos 1)))
    ;; If any position is not found, set boxName to an empty string
    (setq boxName "")
  )

  ;; Add a dot between letters and numbers
  (setq modifiedBoxName "")
  (setq len (strlen boxName))
  (setq i 1)
  (while (<= i len)
    (setq char (substr boxName i 1))
    (if (and (> i 1)
             (or (and (vl-string-search char "0123456789")
                      (vl-string-search (substr boxName (- i 1) 1) "ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖabcdefghijklmnopqrstuvwxyzåäö"))
                 (and (vl-string-search (substr boxName (- i 1) 1) "0123456789")
                      (vl-string-search char "ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖabcdefghijklmnopqrstuvwxyzåäö"))))
      (setq modifiedBoxName (strcat modifiedBoxName "." char))
      (setq modifiedBoxName (strcat modifiedBoxName char))
    )
    (setq i (1+ i))
  )
  (setq boxName modifiedBoxName)

  ;; Add a plus sign in front of the result
  (setq boxName (strcat "+" boxName))

  ;; Return the modified file name
  boxName
)

;; Create the boxName string
(setq boxName (c:getBoxName))

(defun replace-swedish-chars (str)
  (setq replacements (list '("Å" . "\\u00C5") '("Ä" . "\\u00C4") '("Ö" . "\\u00D6")
                           '("å" . "\\u00E5") '("ä" . "\\u00E4") '("ö" . "\\u00F6")))
  (foreach pair replacements
    (setq str (vl-string-subst (cdr pair) (car pair) str)))
  str
)

(defun UpdateBlock (NewTitles / ss obj atts att tag NewText)
  ; Get all block references with type "INSERT" and name "EPCB000"
  (setq ss (ssget "X" '((2 . "EPCB000"))))          ; find the title block (here (1 . "INSERT") is not needed)
  (setq obj (vlax-ename->vla-object (ssname ss 0))) ; Get the title block as a VLA object
  (setq atts (vlax-invoke obj 'Getattributes))      ; List VLA tags / attribute names

  (foreach att atts                                 ; Loop through tags / attributes
    (setq tag (vla-get-tagstring att))              ; Get the 'real' tag name
    (setq NewText (assoc tag NewTitles))            ; Find the tag as a dotted pair in the provided list
    (if NewText                                     ; Check if the tag is in the provided list
        (progn
          (setq NewText (cdr NewText))                    ; get the new tag value
          (vla-put-textstring att NewText)                ; update the tag
          (princ (strcat "\nTag: " tag ", New value: " NewText)) ; Print updated tag and value to the command line
      ) ; end progn
    ) ; end if
  ) ; end foreach
) ; end UpdateBlock


;; SEARCH AND REPLACE
(defun read-utf8-string (str)
  str
)

(defun replace-g11-t11 (str)
  (if str
    (progn
      ;; Replace "G11" with "G12"
      (setq str (vl-string-subst "G12" "G11" str))
      ;; Replace "T11" with "T12"
      (setq str (vl-string-subst "T12" "T11" str))
    )
  )
  str
)

(defun replace-11-12 (str)
  (if str
    (setq str (vl-string-subst ".12." ".11." str))
  )
  str
)

(defun processAttributes ()
  ;; Set the encoding system to UTF-8
  (setq *coding-system* 'utf-8)

  ;; Get the block reference
  (setq ss (ssget "X" '((0 . "INSERT")(2 . "EPCB000"))))
  (setq obj (vlax-ename->vla-object (ssname ss 0)))
  (setq atts (vlax-invoke obj 'Getattributes))

  ;; Initialize D5, D9, and D14
  (setq D5 nil)
  (setq D9 nil)
  (setq D14 nil)

  ;; Loop through the attributes and get their values
  (while atts
    (setq att (car atts))
    (setq atts (cdr atts))
    (setq tag (vla-get-tagstring att))
    (setq value (vla-get-textstring att))
    (cond
      ((equal tag "D5")
       (setq D5 (read-utf8-string value)))
      ((equal tag "D9")
       (setq D9 (read-utf8-string value)))
      ((equal tag "D14")
       (setq D14 (read-utf8-string value)))
    )
  )

  ;; Replace values in D5, D9, and D14
  (setq D5 (replace-g11-t11 D5))
  (setq D9 (replace-g11-t11 D9))
  (setq D14 (replace-11-12 D14))

  ;; Return the processed values
  (list D5 D9 D14)
)

;; Process D5, D9, and D14
(setq processedValues (processAttributes))
(setq D5 (nth 0 processedValues))
(setq D9 (nth 1 processedValues))
(setq D14 (nth 2 processedValues))

;; Create a list of block tags and their values, with Swedish characters replaced with UTF-8 codes
(setq NewTitles (mapcar
  (lambda (pair)
    (cons (car pair) (replace-swedish-chars (cdr pair))))
  (list
    (cons "C2" "KRAFTSTATION")     ;; Facility
    '( "C10" . "506")                  ;; Project number
    '( "D6" . "TBY")                          ;; Drawn border frame left side
    (cons "D7" currentDate)                   ;; Date border frame left side
    '( "D8" . "AN")                         ;; Reviewed border frame left side
    '( "RITAD_AV" . "TBY")                    ;; Drawn border frame bottom
    '( "GRANSK_AV" . "J")                    ;; Reviewed by border frame bottom
    '( "GODK_AV" . "L")                      ;; Approved by border frame bottom
    (cons "GODK_DAT." currentDate)            ;; Approved date border frame bottom 
    (cons "D4" boxName)                       ;; Description row 1 border frame bottom 
    (cons "D5" D5)                            ;; Description row 2 border frame bottom 
    (cons "D9" D9)                            ;; Description row 3 border frame bottom
    (cons "D14" D14)                          ;; Function border frame bottom 
;;  '( "D12" . "")                            ;; Document type border frame bottom 
    (cons "D13" drawingName)                  ;; Drawing number border frame bottom                    
;;  '( "D10" . "")                            ;; Room border frame bottom 
    '( "NOT1" . "")                           ;; Clear revision note 1
    '( "ÄNDRING1" . "")                       ;; Clear revision note 1
    '( "DATUM1" . "")                         ;; Clear revision note 1
    '( "INF.1" . "")                          ;; Clear revision note 1
    '( "GODK.1" . "")                         ;; Clear revision note 1
    '( "NOT2" . "")                           ;; Clear revision note 2
    '( "ÄNDRING2" . "")                       ;; Clear revision note 2
    '( "DATUM2" . "")                         ;; Clear revision note 2
    '( "INF.2" . "")                          ;; Clear revision note 2
    '( "GODK.2" . "")                         ;; Clear revision note 2
    '( "NOT3" . "")                           ;; Clear revision note 3
    '( "ÄNDRING3" . "")                       ;; Clear revision note 3
    '( "DATUM3" . "")                         ;; Clear revision note 3
    '( "INF.3" . "")                          ;; Clear revision note 3
    '( "GODK.3" . "")                         ;; Clear revision note 3
  )
))

(UpdateBlock NewTitles) ; use this list in the 'UpdateBlock' function

;; Update file name in the text field.
(defun replace-text-in-area-with-filename (startpoint endpoint)
  ;; Get the file name including extension
  (setq fullFileName (getvar "DWGNAME"))

  ;; Get all text objects within the specified area
  (setq ss (ssget "C" startpoint endpoint '((0 . "TEXT"))))
  (if ss
    (progn
      (setq count (sslength ss))
      (setq i 0)
      ;; Loop through all selected text objects and replace their text with the file name
      (while (< i count)
        (setq obj (vlax-ename->vla-object (ssname ss i)))
        (vla-put-TextString obj fullFileName)
        (setq i (1+ i))
      )
      (princ (strcat "\nReplaced text in " (itoa count) " objects with the file name: " fullFileName))
    )
    (princ "\nNo text objects found within the specified area.")
  )
)

;; Define the start and end point for the area
(setq startpoint (list 0 277.5 0))
(setq endpoint (list 7 242.5 0))

;; Call the function to replace the text with the file name
(replace-text-in-area-with-filename startpoint endpoint)

(princ) ; exit quietly

 

Edited yesterday at 10:11 AM by nonifo