"I" wrote an insane LISP, well, insane for my standards. probably cake for y'all.

[RubberDinero]

I say "I" in quotes because it was all A.I. 

I have always wanted to ask this forum for help with creating a LISP routine that if I selected a bunch of blocks at once, it would reference a swaplist and automatically swap in the correct block, keep the same insertion, rotation, scale, and check for attributes transfer them over to the new block. But I always thought this was too much of an ask, I know y'all are busy and I didn't want to overstay my welcome by asking for too much. so today, after spending too much time trying to make ChatGPT's write all the code with just a few statements, I spent a few hours treating ChatGPT like a little kid and feeding it one step at a time and only moved on until I got that step to work perfectly. 

 

(vl-load-com)

(setq swaplist
  '(
    ("oldblock1" "newblock1" "layername")
    ("oldblock2" "newblock2" "layername")
	;;Add more lines to per your use
   )

(defun C:BLOCKSWAP ()
  ;; Prompt user to select blocks
  (setq blockList (ssget '((0 . "INSERT"))))  ;; Only get block inserts
  (if (not blockList)
    (progn
      (princ "\nNo blocks selected.")
      (exit)
    )
  )

  ;; Get the count of selected blocks
  (setq blockCount (sslength blockList))

  ;; Initialize a list to hold blocks to be swapped
  (setq blocksToSwap '())

  ;; Collect blocks to be swapped
  (setq i 0)
  (repeat blockCount
    (setq block (ssname blockList i)) ;; Get block by index

    ;; Ensure block is valid before proceeding
    (if (and block (entget block))  ;; Check if block is valid
      (progn
        ;; Get the effective block name
        (setq effectiveName (vla-get-effectivename (vlax-ename->vla-object block))) ;; Get effective name

        ;; Normalize the effective name to upper case for comparison
        (setq effectiveNameUpper (strcase effectiveName))  ;; Convert to upper case for comparison

        ;; Initialize found flag
        (setq found nil)

        ;; Search for the effective name in the swaplist
        (foreach entry swaplist
          (if (equal (car entry) effectiveNameUpper)  ;; Compare directly with the swaplist entry
            (progn
              (setq swapBlock (cadr entry))  ;; Get new block name from swap list
              (setq layer (caddr entry))     ;; Get layer name from swap list
              (setq found t)
            )
          )
        )

        ;; If a match is found, add the block to the blocksToSwap list
        (if found
          (setq blocksToSwap (cons (list block swapBlock layer) blocksToSwap))
        )
      )
    )

    ;; Increment index for the next iteration
    (setq i (1+ i))
  ) ;; End of repeat loop

  ;; Process each block in the blocksToSwap list
  (foreach swapInfo blocksToSwap
    (setq block (car swapInfo))
    (setq swapBlock (cadr swapInfo))
    (setq layer (caddr swapInfo))

    ;; Check if the block exists in the drawing
    (setq blockExists (tblsearch "BLOCK" swapBlock))
    
    ;; If the block does not exist, load it
    (if (null blockExists)
      (progn
        ;; Load the block from the support path without prompting for insertion
        (command "_.-INSERT" swapBlock nil)  ;; Load the block, nil simulates ESC key
        ;; Check again if the block is now loaded
        (setq blockExists (tblsearch "BLOCK" swapBlock)) ;; Check again if the block is now loaded
      )
    )

    ;; Insert the new block using vla-InsertBlock
    (if blockExists  ;; Proceed only if the block was successfully loaded
      (progn
        ;; Get the insertion point, rotation, and scale from the original block
        (setq insertionPoint (vlax-get (vlax-ename->vla-object block) 'InsertionPoint))  ;; Get insertion point as a variant array
        (setq rotation (vla-get-rotation (vlax-ename->vla-object block))) ;; Rotation angle

        ;; Get scale factors from DXF data
        (setq data (entget block)) ;; Get entity data
        (setq scaleX (cdr (assoc 41 data))) ;; X scale factor (DXF code 41)
        (setq scaleY (cdr (assoc 42 data))) ;; Y scale factor (DXF code 42)
        (setq scaleZ (cdr (assoc 43 data))) ;; Z scale factor (DXF code 43)

        ;; Insert the new block
        (setq modelSpace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
        (vla-InsertBlock modelSpace
                         (vlax-3d-point (car insertionPoint) (cadr insertionPoint) (caddr insertionPoint))  ;; Insertion point
                         swapBlock
                         scaleX
                         scaleY
                         scaleZ
                         rotation)

        ;; Set the new block's layer
        (setq newBlockRef (entlast)) ;; Get the last inserted block reference
        (vla-put-layer (vlax-ename->vla-object newBlockRef) layer)

        ;; Get attributes from the original block
        (setq varAttributes (vlax-variant-value (vla-GetAttributes (vlax-ename->vla-object block))))
        
        ;; Check number of attributes
        (setq attrCount (vlax-safearray-get-u-bound varAttributes 1)) ;; Get the upper bound of the attribute array

        ;; Transfer attributes by matching tags
        (if (> attrCount -1)  ;; Ensure there are attributes to transfer
          (progn
            ;; Get the new block's attributes
            (setq newVarAttributes (vlax-variant-value (vla-GetAttributes (vlax-ename->vla-object newBlockRef))))
            (setq newAttrCount (vlax-safearray-get-u-bound newVarAttributes 1)) ;; Get new attributes count

            ;; Loop through original block's attributes
            (setq I 0)
            (while (< I (1+ attrCount)) ;; Iterate through original attributes
              (setq attrObj (vlax-safearray-get-element varAttributes I)) ;; Get the attribute object
              
              ;; Get the tag and value
              (setq tagString (vla-get-TagString attrObj)) ;; Get attribute tag
              (setq textString (vla-get-TextString attrObj)) ;; Get attribute value
              
              ;; Loop through new block's attributes to find a match by tag
              (setq J 0)
              (setq matched nil)
              (while (and (< J (1+ newAttrCount)) (not matched))
                (setq newAttrObj (vlax-safearray-get-element newVarAttributes J)) ;; Get new attribute object
                (if (equal tagString (vla-get-TagString newAttrObj))  ;; Check if tags match
                  (progn
                    (vla-put-TextString newAttrObj textString) ;; Set the value for the new block's attribute
                    (setq matched t)
                  )
                )
                (setq J (1+ J))
              )
              (setq I (1+ I))
            )
          )
        )
        
        ;; Delete the previous block after attributes are transferred
        (vla-Delete (vlax-ename->vla-object block))
      )
    )
  ) ;; End of foreach loop

  (princ) ;; Exit quietly
)

I actually realized that I never asked ChatGPT for the step to change the layer of the new block after insertion, but it did it anyways. probably remembering my conversation. 

This is my experience. you still need to know exactly what you want and you need to treat ChatGPT like a toddler that knows all the answers. 

proceed with VERY small steps. don't be afraid to tell A.I. that you think it placed a certain code outside of the while loop and it would make more sense to put it inside to run per iteration. 

 

 

Trust me, I am not good at writing LISP routines. if you check my history, you can see how excited I got when writing extremely simple code. With a lot of patience, you can create your dream LISP! I have been dreaming of this LISP for years without knowing where to start. Now I got it finished in a few hours!

EDIT: After finding that single attribute blocks didn't work, I asked ChatGPT to fix the way it does the attribute swap by giving an example of a lisp I found online. now this code works great!

Edited 20 hours ago by RubberDinero

[BIGAL]

If you use this makes a list of the attributes, you can then use a (foreach att atts to look at each attribute.

 

(setq atts (vlax-invoke obj 'Getattributes))

 

Using VLAX rather than VLA-get I just find easier (vlax-get obj 'layer), its like a noun verb, verb noun thing.

[RubberDinero]

3 hours ago, BIGAL said:

If you use this makes a list of the attributes, you can then use a (foreach att atts to look at each attribute.

 

(setq atts (vlax-invoke obj 'Getattributes))

 

Using VLAX rather than VLA-get I just find easier (vlax-get obj 'layer), its like a noun verb, verb noun thing.

Wish I could say, why didn’t I think of that, but I think we both know I would have never thought of that. I’m even afraid to ask ChatGPT to try it. Might break something. Although I can always try it on another file.