Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 05/30/2024 in all areas

  1. Here is an update to my generic version that allows for Text selection. At the prompts, you can enter "?" to go to a Select text prompt. ;; New version by Pkenewell. Uses Visual LISP & ActiveX ;; Updated 5/8/2024 to check for existing layers already with new name. ;; - Also updated for optional Prefix and/or Suffix. ;; - Also added new created layer count. ;; Updated 5/30/2024 to add ability to select text for prefix/suffix. (defun C:CNL ( / acdoc cnt el en la llst lt lw lyrs np nl pr ss su tr) (vl-load-com) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) lyrs (vla-get-layers acdoc) ) (vla-StartUndoMark AcDoc) (if (and (setq ss (ssget ":L")) (setq pr (getstring T "\nEnter Prefix for new layers from selected objects <\"?\" to Select Text, ENTER for None>: ")) (if (= pr "?") (progn (while (progn (setvar "errno" 0) (setq en (entsel "\nSelect Text Object for Prefix: ")) (cond ((= 7 (getvar "errno"))(princ "\nNo Object Selected. Try Again...\n")) ((vl-consp en) (if (not (wcmatch (cdr (assoc 0 (entget (car en)))) "TEXT,MTEXT")) (princ "\nInvalid Object Selected. ") ) ) ) ) ) (if en (setq pr (cdr (assoc 1 (entget (car en)))))(setq pr "")) ) T ) (setq su (getstring T "\nEnter suffix for new layers from selected objects <\"?\" to Select Text, ENTER for None>: ")) (if (= su "?") (progn (while (progn (setvar "errno" 0) (setq en (entsel "\nSelect Text Object for Suffix: ")) (cond ((= 7 (getvar "errno"))(princ "\nNo Object Selected. Try Again...\n")) ((vl-consp en) (if (not (wcmatch (cdr (assoc 0 (entget (car en)))) "TEXT,MTEXT")) (princ "\nInvalid Object Selected. ") ) ) ) ) ) (if en (setq su (cdr (assoc 1 (entget (car en)))))(setq su "")) ) T ) (not (= pr su "")) ) (progn (setq en nil) (repeat (setq cnt (sslength ss)) (setq el (entget (ssname ss (setq cnt (1- cnt)))) la (cdr (assoc 8 el)) ) (if (not (member la llst))(setq llst (cons la llst))) ) (setq cnt 0) (foreach n llst (if (not (tblsearch "LAYER" (strcat pr n su))) (progn (setq ob (vlax-ename->vla-object (setq el (tblobjname "LAYER" n))) col (vla-get-truecolor ob) lt (vla-get-linetype ob) lw (vla-get-lineweight ob) np (vla-get-plottable ob) nl (vla-add lyrs (strcat pr (vla-get-name ob) su)) tr (getpropertyvalue el "Transparency") ) (vla-put-truecolor nl col) (vla-put-linetype nl lt) (vla-put-lineweight nl lw) (vla-put-plottable nl np) (setpropertyvalue (vlax-vla-object->ename nl) "Transparency" tr) (if (tblsearch "LAYER" (strcat pr n su))(setq cnt (1+ cnt))) ) ) ) (if (> cnt 0)(princ (strcat "\n(" (itoa cnt) ") New Layers Created."))) ) (if (= pr su "")(princ "\nNo Suffix or Prefix Given - No new layers created.")) ) (vla-EndUndoMark AcDoc) (princ) )
    1 point
  2. Hey pkenewell, I'm still on holiday myself, I had some spare time due to weather so looked through some files. I wasn't expecting you to do anything whilst your away , but seeing as you have lol i will indeed give it a go when I get back tomorrow
    1 point
  3. @Sharper Hi - I've been on Holiday but didn't forget you , Please give this code a try. I minimally tested it with the example code you posted and it worked. Alter the path and file extension to suit you needs in the UPDATEGC command. Just in case - I recommend you backup your Gcode file before using. ;; Escape Wildcards - Lee Mac ;; Escapes wildcard special characters in a supplied string (defun LM:escapewildcards ( str ) (if (wcmatch str "*[-#@.*?~`[`,]*,*`]*") (if (wcmatch str "[-#@.*?~`[`,]*,`]*") (strcat "`" (substr str 1 1) (LM:escapewildcards (substr str 2))) (strcat (substr str 1 1) (LM:escapewildcards (substr str 2))) ) str ) ) (defun ReplaceCodes (file kw1 kw2 / flg fp ln ls n) (if (and file (setq file (findfile file))) (progn (setq fp (open file "r") flg nil) (while (setq ln (read-line fp)) (if (wcmatch ln (strcat "*" (LM:escapewildcards kw1) "*")) (setq ln (vl-string-subst kw2 kw1 ln) ls (cons ln ls) flg T ) (setq ls (cons ln ls)) ) ) (close fp) (if (and ls flg) (progn (setq fp (open file "w") ls (reverse ls) n 0 ) (repeat (length ls) (write-line (nth n ls) fp) (setq n (1+ n)) ) (close fp) (princ "\nFile Updated.") ) (princ "\nNo lines found in file that match the pattern. ") ) ) (princ "\nFile Not found.") ) (princ) ) (defun c:UpdateGC () (if (setq fil (getfiled "Select Gcode File to Update" "C:\\Myfolder\\" "gco" 4)) (ReplaceCodes fil "Qualify(1.000,0.0,0.0)" "Qualify(1.000,0.0,0.035)") ) ) Thanks to Lee Mac for the "Escape Wildcards" code.
    1 point
  4. I recommend continuing to use CSV for input purposes. or create xlsx by csv file without moving cells, and save it as csv using save as when inputting. You may be able to use column widths, colors, and formulas. CSV file is simply separated by commas, without any additional code, so it is easy and fast to read. you can compare the difficulty levels by right-clicking the xlsx file and csv file and selecting notepad from open with. Nevertheless, if you want to do it, look for "getexcel.lsp"
    1 point
×
×
  • Create New...