Author Topic: Replace user specified value in any attribute with lisp  (Read 1061 times)

0 Members and 1 Guest are viewing this topic.

PM

  • Guest
Replace user specified value in any attribute with lisp
« on: November 05, 2022, 12:20:31 PM »
Hi i use ASRM lisp to replace values in multiple block attribiute. I want to do a change in this code. This code ask me to select all the blocks i want to do the change. I want to pick only one block (spesific block) and then automatic select all same blocks in the drawing. I use multiple attribute blocks and sometimes I want to change to spesific type of block and not to all blocks in the drawing.


Code - Auto/Visual Lisp: [Select]
  1.  
  2. ;; Get Attribute Values  -  Lee Mac
  3. ;; Returns an association list of attributes present in the supplied block.
  4. ;; blk - [ent] Block (Insert) Entity Name
  5. ;; Returns: [lst] Association list of ((<tag> . <value>) ... )
  6. ;; http://www.lee-mac.com/attributefunctions.html#algetattributevaluerc
  7. (defun LM:getattributevalues ( blk / enx )
  8.     (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
  9.         (cons
  10.             (cons
  11.                 (cdr (assoc 2 enx))
  12.                 (cdr (assoc 1 (reverse enx)))
  13.             )
  14.             (LM:getattributevalues blk)
  15.         )
  16.     )
  17. )
  18.  
  19. ;; Set Attribute Value  -  Lee Mac
  20. ;; Sets the value of the first attribute with the given tag found within the block, if present.
  21. ;; blk - [vla] VLA Block Reference Object
  22. ;; tag - [str] Attribute TagString
  23. ;; val - [str] Attribute Value
  24. ;; Returns: [str] Attribute value if successful, else nil.
  25. (defun LM:vl-setattributevalue ( blk tag val )
  26.     (setq tag (strcase tag))
  27.     (vl-some
  28.        '(lambda ( att )
  29.             (if (= tag (strcase (vla-get-tagstring att)))
  30.                 (progn (vla-put-textstring att val) val)
  31.             )
  32.         )
  33.         (vlax-invoke blk 'getattributes)
  34.     )
  35. )
  36.  
  37. ;;;;;;;;;;;;;
  38.  
  39. ;; ASR  for Attribute String Replace
  40. (defun c:ASR ( / from to ss i atts blk a tag val newval)
  41.   (setq from (getstring "\nString to be replaced: "))
  42.   (setq to (getstring "\nString to replace to: "))
  43.   ;;(setq from "AZERTY")
  44.   ;;(setq to "QUERTY")
  45.   (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))
  46.   (setq i 0)
  47.   (repeat (sslength ss)
  48.     (setq blk (ssname ss i))
  49.     (setq atts (LM:getattributevalues blk))
  50.     (foreach a atts
  51.       (setq tag (car a))
  52.       (setq val (cdr a))
  53.       (if (vl-string-search from val ) (progn
  54.         (setq newval (vl-string-subst to from val))
  55.         ;; substitute the attribute
  56.         (LM:vl-setattributevalue (vlax-ename->vla-object blk) tag newval)
  57.       ))
  58.     )
  59.     (setq i (+ i 1))
  60.   )
  61. )
  62.  
  63. ;; ASRM  for Attribute String Replace Multiple.
  64. ;; Same as ASR, except it changes multiple instances of the the "from" to "to"
  65. (defun c:ASRM ( / from to ss i atts blk a tag val newval)
  66.   (setq from (getstring "\nString to be replaced: "))
  67.   (setq to (getstring "\nString to replace to: "))
  68.   ;;(setq from "AZERTY")
  69.   ;;(setq to "QUERTY")
  70.   (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))
  71.   (setq i 0)
  72.   (repeat (sslength ss)
  73.     (setq blk (ssname ss i))
  74.     (setq atts (LM:getattributevalues blk))
  75.     (foreach a atts
  76.       (setq tag (car a))
  77.       (setq val (cdr a))
  78.       (while (vl-string-search from val ) (progn
  79.         (setq newval (vl-string-subst to from val))
  80.         ;; substitute the attribute
  81.         (LM:vl-setattributevalue (vlax-ename->vla-object blk) tag newval)
  82.                 (setq val newval)
  83.       ))
  84.     )
  85.     (setq i (+ i 1))
  86.   )
  87. )
  88.  

Thanks

PM

  • Guest
Re: Replace user specified value in any attribute with lisp
« Reply #1 on: November 06, 2022, 03:07:51 AM »
I add some lines to the code. Works but i don't know if is a better way to do this

Code - Auto/Visual Lisp: [Select]
  1.  
  2. ;; Get Attribute Values  -  Lee Mac
  3. ;; Returns an association list of attributes present in the supplied block.
  4. ;; blk - [ent] Block (Insert) Entity Name
  5. ;; Returns: [lst] Association list of ((<tag> . <value>) ... )
  6. ;; http://www.lee-mac.com/attributefunctions.html#algetattributevaluerc
  7. (defun LM:getattributevalues ( blk / enx )
  8.     (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
  9.         (cons
  10.             (cons
  11.                 (cdr (assoc 2 enx))
  12.                 (cdr (assoc 1 (reverse enx)))
  13.             )
  14.             (LM:getattributevalues blk)
  15.         )
  16.     )
  17. )
  18.  
  19. ;; Set Attribute Value  -  Lee Mac
  20. ;; Sets the value of the first attribute with the given tag found within the block, if present.
  21. ;; blk - [vla] VLA Block Reference Object
  22. ;; tag - [str] Attribute TagString
  23. ;; val - [str] Attribute Value
  24. ;; Returns: [str] Attribute value if successful, else nil.
  25. (defun LM:vl-setattributevalue ( blk tag val )
  26.     (setq tag (strcase tag))
  27.     (vl-some
  28.        '(lambda ( att )
  29.             (if (= tag (strcase (vla-get-tagstring att)))
  30.                 (progn (vla-put-textstring att val) val)
  31.             )
  32.         )
  33.         (vlax-invoke blk 'getattributes)
  34.     )
  35. )
  36.  
  37. ;;;;;;;;;;;;;
  38.  
  39. ;; ASR  for Attribute String Replace
  40. (defun c:ASR ( / from to ss i atts blk a tag val newval)
  41.   (setq from (getstring "\nString to be replaced: "))
  42.   (setq to (getstring "\nString to replace to: "))
  43.   ;;(setq from "AZERTY")
  44.   ;;(setq to "QUERTY")
  45.   (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))
  46.   (setq i 0)
  47.   (repeat (sslength ss)
  48.     (setq blk (ssname ss i))
  49.     (setq atts (LM:getattributevalues blk))
  50.     (foreach a atts
  51.       (setq tag (car a))
  52.       (setq val (cdr a))
  53.       (if (vl-string-search from val ) (progn
  54.         (setq newval (vl-string-subst to from val))
  55.         ;; substitute the attribute
  56.         (LM:vl-setattributevalue (vlax-ename->vla-object blk) tag newval)
  57.       ))
  58.     )
  59.     (setq i (+ i 1))
  60.   )
  61. )
  62.  
  63. ;; ASRM  for Attribute String Replace Multiple.
  64. ;; Same as ASR, except it changes multiple instances of the the "from" to "to"
  65. (defun c:ASRM ( / from to ss i atts blk a tag val newval)
  66.  
  67. ;============================================
  68.  (setq e (entsel "\nSelect a block name to select: "))
  69.  (if e (setq ss (ssget "_X" (list(cons 2 (cdr (assoc 2 (entget (car e)))))(cons 0 "INSERT")))))
  70.  (if (zerop (getvar "CMDACTIVE"))
  71.   (progn (sssetfirst ss ss)(princ "Use 'P' for this selection set: ")(princ))
  72.    ss
  73.  )
  74. ;================================================
  75.  
  76.   (setq from (getstring "\nString to be replaced: "))
  77.   (setq to (getstring "\nString to replace to: "))
  78.   ;;(setq from "AZERTY")
  79.   ;;(setq to "QUERTY")
  80.   (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))
  81.   (setq i 0)
  82.   (repeat (sslength ss)
  83.     (setq blk (ssname ss i))
  84.     (setq atts (LM:getattributevalues blk))
  85.     (foreach a atts
  86.       (setq tag (car a))
  87.       (setq val (cdr a))
  88.       (while (vl-string-search from val ) (progn
  89.         (setq newval (vl-string-subst to from val))
  90.         ;; substitute the attribute
  91.         (LM:vl-setattributevalue (vlax-ename->vla-object blk) tag newval)
  92.                 (setq val newval)
  93.       ))
  94.     )
  95.     (setq i (+ i 1))
  96.   )
  97. )
  98.  

Thanks