Leaderboard

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!

Well done, onto a slippery slope though "I wonder if I can make a LISP that can do....." We might need a sample of a drawing to check and confirm how you draw things. I'll take a guess that the parking bay lines are unique in some way, perhaps on their own layer, so to set you off you might use ssget with a filter for the layer (setq ParkingLines (ssget (list (cons 8 Parking-Lines-Layer))) ) and if you use (ssget "_X" ... ) it will select everything else you select in the first example ( see https://lee-mac.com/ssget.html - Lee Mac has a lot of excellent resources, same as this website, AfraLisp and The Swamp) In your code you can then ditch the (repeat 1000) (by the way there are better ways but this can work) and use a while loop perhaps: (setq acount 0) (while (< acount (sslength ParkingLines)) ... do stuff (setq MyLine (ssname ParkingLines acount)) (command "_.chprop" MyLine "" "LT" "Bylayer" "LA" "PR-HATCH-PARKING BAY-RESIDENT PERMIT ONLY" "") ;set item to layer .... (setq acount (+ acount 1)) ) ; end while If it was me I'd perhaps create a selection set of the parking bay lines and loop through that set (as above), zoom to and highlighting each polyline in turn (use redraw -entity name- 3 to highlight, 4 to remove highlight), user can select side, draw the hatch and move on. If the parking bay line is always [ shaped and a polyline you could automate the offset side by using the 1st point in the polyline definition as the offset selection. If I remember after the weekend this might be an interesting on to look at

From here: https://stackoverflow.com/questions/19098260/translate-text-using-vba If you can copy to excel then this might be the start of a macro to translate - not something I've ever needed to do but can LISP run an excel macro? (excel macro, not LISP below) Function Translate$(sText$, FromLang$, ToLang$) Dim p1&, p2&, url$, resp$ Const DIV_RESULT$ = "<div class=""result-container"">" Const URL_TEMPLATE$ = "https://translate.google.com/m?hl=[from]&sl=[from]&tl=[to]&ie=UTF-8&prev=_m&q=" url = URL_TEMPLATE & WorksheetFunction.EncodeURL(sText) url = Replace(url, "[to]", ToLang) url = Replace(url, "[from]", FromLang) resp = WorksheetFunction.WebService(url) p1 = InStr(resp, DIV_RESULT) If p1 Then p1 = p1 + Len(DIV_RESULT) p2 = InStr(p1, resp, "</div>") Translate = Mid$(resp, p1, p2 - p1) End If End Function =Translate(A1, "en", "fr") '<--translates text in A1 from English to French. URL = "https://translate.google.com/#" & langFrom & "/" & langTo & "/" & Text appears to be the key to this for google translate but I also think that free translate is limited to the number of text strings you can do daily. If you can extract the result from the webpage you could do it directly? ....https://translate.google.com/?sl=auto&tl=fr&text=Hello&op=translate

And here is my way: (defun c:txt_out( / ss file el i) (setq file (open (getfiled "Select OUTput" (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname"))) "csv" 1) "w")) (setq ss (ssget "X" (list (cons 0 "*TEXT")))) (repeat (setq i (sslength ss)) (write-line (strcat (cdr (assoc 1 (setq el (entget (ssname ss (setq i (1- i))))))) ";" (cdr (assoc 5 el))) file) ) (print "ok") (close file) ) (defun c:txt_in( / file ss line limit el continue i) (setq file (open (getfiled "Select INput" "" "csv" 4) "r")) (setq ss (ssget "X" (list (cons 0 "*TEXT")))) (setq line (read-line file)) (while line (setq limit (vl-string-search ";" line) txt (substr line 1 limit) hand (substr line (+ 2 limit))) (setq continue T i (sslength ss)) (while continue (setq el (entget (ssname ss (setq i (1- i)))) continue (not (= hand (cdr (assoc 5 el)))) ) ) (entmod (subst (cons 1 txt) (assoc 1 el) el)) (setq line (read-line file)) ) (close file) ) Usage: First of all, make a safety-copy of the drawing. Load these Lisp routines and use the TXT_OUT to get all the texts in a CSV file. The drawing file must remain open, don't edit it any more!!!!! Open that CSV in Excel and translate the first column. Use online translators or so... I used to pass the CSV file to a nice lady in the neighbor office to translate it for me. Edit only the first column in the CSV document! Save the changes and return to AutoCAD. Start the 2nd Lisp TXT_IN and point the CSV file you just saved. The Lisp should do the rest for you.

Something like this (untested by the way, be aware of typos). User needs to change a few details - drawing template names etc. and add this to the startup suit. It should load a LISP file and run routines in it if the current drawing is defined in this LISP. Could be neater coding but quick and easy works just as well. From lastknownusers comment, you can have lisps with the same name saved in different files, this will load a specified file and so those LISPs will be the active ones as this runs. (Defun C:TestForDrawing ( / MyTemplate1 MyTemplate2 MyTemplate3 ) (setq MyTemplate1 "MyTemplateFile1.Dwt") ;;User hard coded template file name 1 (setq MyTemplate2 "MyTemplateFile2.Dwt") ;;User hard coded template file name 1 (setq MyTemplate3 "MyTemplateFile3.Dwt") ;;User hard coded template file name 1 (if (or ;; If current drawing is in template list (= (strcase (getvar 'dwgname)) (strcase MyTemplate1)) ;;User updates these 3 lines according to (= (strcase (getvar 'dwgname)) (strcase MyTemplate2)) ;;'Mytemplate' defined above (= (strcase (getvar 'dwgname)) (strcase MyTemplate3)) ;;Should do this as a list, but quick and dirty ) (progn ;; Do this (load "C:/SP/AutoCAD/Lisps/AutoRunLisps.lsp") ;;Load this file: User hard codes this (c:AR1) ;;Run this routine saved in above file (c:AR2) ;;And this (c:AR3) ;;And this... (load "C:/SP/AutoCAD/Lisps/TemplateLisps.lsp") ;;Another file to load and run (c:TL1) (c:TL1) (c:TL1) ) ; end progn ) ; end if ) ; end defun (C:TestForDrawing) ;; Autorun on load

A bit of a guess here.... yesterday (?) you asked and today it is magically fixed after restarting the computer overnight and restarting CAD... might be that you need to localise your variables and yesterday it was picking up values you were using elsewhere? That is my number 1 cause of something working today that didn't work yesterday

You want it to work for other types of objects, other than blocks. The issue is: not all types of objects heve the properties you need. Text objects don't have a scale, they have a text height. Lines don't have a position, they have 2 insertpoints. ... ----------- Anyway, I think this does the most generic version of copying an object and pasting it to the position of selected destination objects. (defun c:BRE2 ( / src src_ dest ss i temp) (princ "\nSelect source object: ") (setq src_ (vlax-ename->vla-object (setq src (car (entsel))))) (princ "\nSelect objects to be repalced: ") (setq ss (ssget "_:L" '((0 . "*")))) (setq i 0) (repeat (sslength ss) (setq dest (ssname ss i)) (setq temp (vla-copy src_)) ;; copy source (vla-move temp ;; move the copy to the destination (vlax-3d-point (cdr (assoc 10 (entget src)))) (vlax-3d-point (cdr (assoc 10 (entget dest)))) ) (entdel dest) (setq i (+ i 1)) ) ) Do you need this to do more?

Hope this work for you and as per your needs . (defun c:TesT (/ s i d p v) ;;; Tharwat 14. Dec. 2011 ;;; (if (and (setq s (car (entsel "\n Select entity :"))) (member (cdr (assoc 0 (entget s))) '("*LINE" "CIRCLE" "ARC" "ELLIPSE")) (setq i (getint "\n number of offset times :")) (setq d (getdist "\n Distance of offset :")) (setq p (getpoint "\n Specify point on side to offset :")) (setq v d) ) (repeat i (command "_.offset" d s p "") (setq d (+ d v))) (princ) ) (princ) )

a few more links HideShow - hide selected objects from AutoCAD drawing (VLX for AutoCAD) Easily hide and isolate objects in AutoCAD 2011 Freeze Object(s) Quick and dirty (defun c:invis (/ errCount wMode objSet showset actDoc *error*) ;; ==================================================================== ;; ;; ;; ;; INVIS.LSP - Makes objects temporarily invisible and ;; ;; visible return of all or some ;; ;; ;; ;; ==================================================================== ;; ;; ;; ;; Command(s) to call: INVIS ;; ;; ;; ;; ==================================================================== ;; ;; ;; ;; THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY ;; ;; MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR ;; ;; PARTS OF IT ABSOLUTELY FREE. ;; ;; ;; ;; THIS PROGRAM PROVIDES 'AS IS' WITH ALL FAULTS AND SPECIFICALLY ;; ;; DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS ;; ;; FOR A PARTICULAR USE. ;; ;; ;; ;; ==================================================================== ;; ;; ;; ;; V1.1, 11th Apr 2005, Riga, Latvia ;; ;; © Aleksandr Smirnov (ASMI) ;; ;; For AutoCAD 2000 - 2008 (isn't tested in a next versions) ;; ;; ;; ;;http://www.cadtutor.net/forum/showthread.php?43876-AsmiTools ;; ;; ==================================================================== ;; ;; ;; ;; V1.2, 02 June 2011, Minsk, Belarus ;; ;; © Vladimir Azarko (VVA) ;; ;; For AutoCAD 2000 - 2011 (isn't tested in a next versions) ;; ;; Add mode "Show some object" ;; ;; V1.3, 04 may 2013, Minsk, Belarus ;; ;; © Vladimir Azarko (VVA) ;; ;; For AutoCAD 2000 - 2011 (isn't tested in a next versions) ;; ;; Add mode "Show selected Only" ;; ;; ;; ;;http://www.cadtutor.net/forum/showthread.php?59655 ;; ;; ==================================================================== ;; ;; ;; (vl-load-com) (defun put_Visible_Prop (Object Flag) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-visible (list Object Flag) ) ) (setq errCount (1+ errCount)) );_ end if (princ) );_ end of put_Visible_Prop (defun Set_to_List (SelSet) (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex SelSet)) ) ) );_ end of Set_to_List (defun errMsg () (if (/= 0 errCount) (princ (strcat ", " (itoa errCount) " were on locked layer." ) ) "." );_ end if );_ end of errMsg (setq actDoc (vla-get-ActiveDocument (vlax-get-Acad-object) ) errCount 0 );_ end setq (vla-StartUndoMark actDoc) (initget "Visible Invisible Show Only" 1) (setq wMode (getkword "\nMake objects [Visible all/Invisible/Show some invisible objects/show selected Only]: " ) ) (cond ((and (= wMode "Visible") (setq objSet (ssget "_X" '((60 . 1)))) );_ end and (setq objSet (Set_to_List objSet)) (mapcar '(lambda (x) (put_Visible_Prop x :vlax-true)) objSet ) (princ (strcat "\n<< " (itoa (- (length objSet) errCount)) " now visible" (errMsg) " >>" ) ) ) ;_ # condition ((and (= wMode "Show") (setq objSet (ssget "_X" '((60 . 1)))) );_ end and (setq objSet (Set_to_List objSet)) (mapcar '(lambda (x) (put_Visible_Prop x :vlax-true)) objSet ) (princ (strcat "\n<< " (itoa (- (length objSet) errCount)) " now visible" (errMsg) " >>" ) ) (princ "\nSelect objects to show") (if (setq showset (ssget "_:L")) (progn (setq showset (Set_to_List showset)) (foreach item showset (setq objSet (vl-remove item objSet)) ) (mapcar '(lambda (x) (put_Visible_Prop x :vlax-false)) objSet ) ) ) ) ;_ # condition ((= wMode "Only") (if (not (setq objSet (ssget "_I"))) (setq objSet (ssget)) ) ;_ end if (if (and objset (setq objSet (Set_to_List objSet))) (progn (setq showset (ssget "_X" (list (cons 410 (getvar 'Ctab)))) showset (Set_to_List showset) ) (foreach item objSet (setq showset (vl-remove item showset)) ) (mapcar '(lambda (x) (put_Visible_Prop x :vlax-false)) showset ) (princ (strcat "\n<< " (itoa (- (length showset) errCount)) " now invisible" (errMsg) " >>" ) ) ) ) ) ;_ # condition (t (if (not (setq objSet (ssget "_I"))) (setq objSet (ssget)) );_ end if (if objSet (progn (setq objSet (Set_to_List objSet)) (mapcar '(lambda (x) (put_Visible_Prop x :vlax-false)) objSet ) (princ (strcat "\n<< " (itoa (- (length objSet) errCount)) " now invisible" (errMsg) " >>" ) ) );_ end progn );_ end if ) );_ end cond (vla-EndUndoMark actDoc) (princ) );_ end of c:invis (mapcar 'princ (list "\n[info] http://www.cadtutor.net/forum/showthread.php?59655 [info]" "\nType INVIS to make objects invisible or visible." ) ) (princ)