"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 October 4 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.

[RubberDinero]

 

Here is pretty much the final version. The purpose of this code is to change all current blocks, which are considered "Proposed"  to an "Existing" type block then put those blocks to the correct existing layer. The updated code also gets any line work and changes them from their layer ending in -PR to a respective layer that does not have the PR.

This is extremely useful because once the job is constructed/built, if you need to reference that job in your current job, everything needs to be changed to existing. every block and every line or polyline that was once proposed, needs to be updated.

 

So this is pretty much the final version. for the most part the vast majority uses lineweights, but some use global width on polylines. I was thinking of adding a "read current global width then halve it" or "if polyline, set global width to 0". but it's not that hard of a change, especially with using the quick select menu by global width. 

 

 

;;swaplist from previous code

(defun c:ProToEx (/ selection blockList nonBlockList blockCount nonBlockCount i block obj data layerName newLayer objType)
  ;; Prompt user to select all objects
  (setq selection (ssget))  ;; Let the user select anything

  ;; Check if the selection is valid
  (if (not selection)
    (progn
      (exit)
    )
  )

  ;; Separate selection into blocks and non-blocks
  (setq blockList '())
  (setq nonBlockList '())
  (setq blockCount (sslength selection))  ;; Get the count of selected objects
  (setq i 0)

  ;; Iterate through the selection set to classify objects
  (while (< i blockCount)
    (setq obj (ssname selection i))  ;; Get object by index
    (setq data (entget obj))  ;; Get entity data
    (setq objType (cdr (assoc 0 data)))  ;; Get the object type

    ;; Check if the object is a block reference
    (if (equal objType "INSERT")
      (setq blockList (cons obj blockList))  ;; Add to blockList
      (setq nonBlockList (cons obj nonBlockList))  ;; Add to nonBlockList
    )
    (setq i (1+ i))  ;; Increment index for the next object
  )

  ;; Process blocks with BLOCKSWAP function
  (if blockList
    (progn
      ;; Initialize a list to hold blocks to be swapped
      (setq blocksToSwap '())
      (setq blockCount (length blockList))  ;; Get the count of selected blocks
      (setq i 0)
      
      ;; Collect blocks to be swapped
      (repeat blockCount
        (setq block (nth i blockList)) ;; 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
    )
  )

  ;; Process non-blocks with ChangeLayerNonPR function
  (if nonBlockList
    (progn
      (setq nonBlockCount (length nonBlockList))  ;; Get the number of non-block objects
      ;; Loop through each non-block object
      (setq i 0)  ;; Initialize index
      (while (< i nonBlockCount)
        (setq obj (nth i nonBlockList))  ;; Get object by index
        (setq data (entget obj))  ;; Get entity data
        (setq objType (cdr (assoc 0 data)))  ;; Get the object type

        ;; Ensure the object is not a block reference
        (if (not (equal objType "INSERT"))
          (progn
            (setq layerName (cdr (assoc 8 data)))  ;; Get the layer name (DXF code 8)

            ;; Check if the layer name ends with "-PR"
            (if (wcmatch layerName "*-PR")
              (progn
                ;; Generate the new layer name by removing "-PR"
                (setq newLayer (substr layerName 1 (- (strlen layerName) 3)))

                ;; Change the object to the new layer
                (entmod (subst (cons 8 newLayer) (assoc 8 data) data))
              )
            )
          )
        )
        ;; Increment index for next non-block object
        (setq i (1+ i))
      )
    )
  )

  (princ)  ;; Exit quietly
)

 

[BIGAL]

Just a quick comment did much the same would add EX- to a project for all layers that matched a text file with layer names, the colors and linetypes were also changed, these layers were generated from field survey data ie CIV3D. So can have more than just *-PR our designs would have like 30 extra layers at least. Making a layer text file is pretty easy as can dump layer details to a file.

[RubberDinero]

2 hours ago, BIGAL said:

Just a quick comment did much the same would add EX- to a project for all layers that matched a text file with layer names, the colors and linetypes were also changed, these layers were generated from field survey data ie CIV3D. So can have more than just *-PR our designs would have like 30 extra layers at least. Making a layer text file is pretty easy as can dump layer details to a file.

I initially wanted the LISP to read an external file that could be updated manually, but I never figured out, even using ChatGPT, how to read each line, delimit it and turn it into a list.

Our template has every layer we could ever need and it's either end with -PR for proposed or no -PR for existing. Just read through the code and it says, "generate new layer name" but this essentially is not needed as the layer name would already exist, but it works, so I'm gonna leave it as is.