Leaderboard

just a simplified example with GRREAD (only works for TEXT with integers and currently no undo built in) (defun RlxSel1 ( $e-type / done-selecting inp i p2 result e ent) (princ (strcat "\nEsc, enter, Rmouse to cancel, zoom with E(extend), Z(oom) or + / -\nSelect " $e-type)) (setq done-selecting nil) (while (not done-selecting) (setq inp (vl-catch-all-apply 'grread (list nil 4 2))) (if (vl-catch-all-error-p inp) (setq done-selecting t result nil) (cond ; if point selected ((= (car inp) 3) ; if point has object under it (if (setq ent (nentselp (cadr inp))) (setq e (car ent) typ (get_type e))) (cond ; if we have object and object is the right type we have a winner ((and e typ (eq $e-type typ)) (redraw e 3)(setq done-selecting t result e)) ; maybe its the parent ; this happens when type is dimension and you select dimensions text ((and (caddr ent) (setq ent (last (last ent)))(eq $e-type (get_type ent))) (redraw ent 3)(setq done-selecting t result ent)) ; sorry object is not the right stuf ((and e typ (not (eq $e-type typ))) (princ (strcat "\rYou selected the wrong type (" $e-type ")"))) ; else try crossing selection (t (if (and (setq i 0 p2 (getcorner (cadr inp) "\tOther corner : ")) (setq ss (ssget "c" (cadr inp) p2))) (while (setq e (ssname ss i)) (if (= (cdr (assoc 0 (entget e))) $e-type) (progn (redraw e 3) (setq result e done-selecting t))) (setq i (1+ i)))) );end t ); end cond ); end (= (car inp) 3) ; user pressed E of e ((member inp '((2 69)(2 101))) (command "zoom" "e")) ; user clicked R-mouse button, pressed enter or space (done selecting) ((or (equal (car inp) 25)(member inp '((2 13)(2 32)))) (setq done-selecting t result nil)) ; user pressed + ((equal inp '(2 43)) (command "zoom" "2x")) ; user pressed - ((equal inp '(2 45)) (command "zoom" ".5x")) ; user pressed z or Z ((member inp '((2 122)(2 90))) (command "'zoom" "")) ;;; enter undo routine here ;;; *********************** ) ) ) result ) ; 'kelvinated' (compressed) version of vt_splituptext ; (splitss (getvar 'dwgname)) -> ("06" "E" "001474" "S" "0011" ".DWG") ; (vl-remove-if-not 'distof (splitss "06E001474S0011.dwg")) -> ("06" "001474" "0011") ;;; (setq r (Splitss (cdr (assoc 1 (entget (car (entsel))))))) (defun splitss (s / a c p l d i) (if (and s (= (type s) 'str)(> (strlen s) 0)(setq i 1)(setq d ""))(progn (if (wcmatch (substr s i 1) "#")(setq p "num")(setq p "s")) (while (<= i (strlen s))(if (wcmatch (substr s i 1) "#")(setq c "num")(setq c "s"))(if (= c p)(setq d (strcat d (substr s i 1))) (progn (setq l (append l (list d)) p c d (substr s i 1))))(setq i (1+ i)))(if (and d (/= d ""))(setq l (append l (list d)))))) l) (defun isnum (n)(if (distof n) t nil)) (defun get_type ( %o ) (cond ((= (type %o) 'ENAME)(cdr (assoc 0 (entget %o)))) ((= (type %o) 'VLA-object)(cdr (assoc 0 (entget (vlax-vla-object->ename %o))))) (t nil) ) ) ;;; test 1 : increment with 1 (defun c:t1 ( / inc sel) (setq inc 1) (while (setq sel (RlxSel1 "TEXT")) (inc_ent sel)) (princ) ) (defun inc_ent (e / ent ent-type str-lst new-str-lst new-str done s len) (cond ((null e) (alert "Computer says no : nothing selected")) ((not (eq (type e) 'ename)) (alert (strcat "Computer says no : wrong type (" (vl-princ-to-string (type e)) ")"))) ((not (eq (setq ent-type (cdr (assoc 0 (setq ent (entget e))))) "TEXT")) (alert (strcat "Computer says no : selected object is not a text (" (vl-princ-to-string ent-type) ")"))) (t ;;; assuming last number must be incremented I reverse the string list and work from end to begin (setq done nil new-str-lst '() str-lst (reverse (Splitss (cdr (assoc 1 ent))))) (while (and (vl-consp str-lst) (not done) (setq s (car str-lst))) (setq str-lst (cdr str-lst)) (if (isnum s) (progn ;;; make sure "001" becomes "002" and not "2" (setq len (strlen s)) ;;; increment string with inc (setq s (itoa (+ inc (atoi s)))) ;;; put back leading zero's (while (< (strlen s) len) (setq s (strcat "0" s))) ;;; save to new string list (setq new-str-lst (cons s new-str-lst) done T) ) (setq new-str-lst (cons s new-str-lst)) );;; end if );;; end while (while (vl-consp str-lst) (setq new-str-lst (cons (car str-lst) new-str-lst) str-lst (cdr str-lst))) ;;; put string back together (if (vl-consp new-str-lst) (setq new-str (apply 'strcat new-str-lst))) ;;; update text object (setq ent (subst (cons 1 new-str) (assoc 1 ent) ent)) ;;; update ent (entmod ent)(entupd e) ) ) ) for undo to work built an undo (assoc) list with ent + original text string and when undoing get last ent in list , reset text and remove it from undo-list. Should look something like this : (setq undo-list (reverse (cdr (reverse undo-list)))) Unless you built this list with cons , then (setq undo-list (cdr undo-list)) will work too. I do have a far more advanced program (VT.lsp) for my increment jobs , posted it years ago , which I still use to this day. Added lots of options through the years but most of them are so company specific I don't think its useful to post the latest version (also it still doesn't like Mtext) because I have no use for Mtext for my line of work so every time I see one I blow it out of the water.

If you just want a add to X & Y why not use move with 0,0,0 X,Y,0.

yes, you are right, already deleted this again thanks again

It's working quite well! I only had to exchange of course as well for the copy text part in the code. I also added the "while T" for the Multiple like mentioned in the first post. Thanks a lot for your help!

@klbr I think your going about this the wrong way: 1) in your loop, you have no way of filtering for Polylines, so it will change ANYTHING that has a DXF code 10 (which is most of your geometric entities, text, blocks, etc.). It is much easier to perform the function (ssget "X" '((0 . "LWPOLYLINE"))) to get the selection set of Polylines, then iterate through it. 2) Since your loop is re-arranging the database, en will never equal entlast, which is why the loop doesn't stop. Here is what I would recommend: (defun c:tf (/ el el2 en i ss) (if (setq ss (ssget "X" '((0 . "LWPOLYLINE")))) (repeat (setq i (sslength ss)) (setq en (ssname ss (setq i (1- i))) el (entget en) el2 nil ) (foreach d el (if (= (car d) 10) (setq el2 (append el2 (list (list (car d) (+ 100.0 (cadr d)) (+ 100.0 (caddr d)))))) (setq el2 (append el2 (list d))) ) ) (entmod el2) ) ) (princ) )

No problem So just a feedback, it works as I planned! Thanks all for help!!! Here is full code: (vl-load-com) (defun C:TNC ( / *error* oldErr osm activeDoc docModelspace mainObject mainText prefixText userInput position incNum suffixText prefixList incStep targetObject targetData changedEntities) ;; Rutine for increasing number in text object by chosen prefix and costum incremental step (setq oldErr *error* *error* LM:error) (setq osm (getvar 'osmode)) (setvar 'osmode 0) (setq mainObject (car (entsel "\nSelect text object: ")) activeDoc (vla-get-activedocument (vlax-get-acad-object)) docModelspace (vla-get-modelspace activeDoc)) (while (or (= mainObject nil) ; Check if user clicked on background (and (not (= "AcDbText" (vla-get-objectname (vlax-ename->vla-object mainObject)))) ; Check if user clicked on Text object (not (= "AcDbMText" (vla-get-objectname (vlax-ename->vla-object mainObject))))) ; Check if user clicked on MText object (not (MM:check-for-numbers "some" (LM:remove-rich-format (vla-get-TextString (vlax-ename->vla-object mainObject))))) ; Check if text object contains any numbers ) ; or end (setq mainObject (car (entsel "\nInvalid selection, try again: "))) ; Returns user information of invalid selection ) ; while end (setq mainText (vla-get-TextString (vlax-ename->vla-object mainObject))) ; Get selected text object content (setq mainText (LM:remove-rich-format mainText)) ; Remove rich text format from text (if (MM:check-for-numbers "every" (MM:trim-non-numerical-from-sides mainText)) ; Check if there's only one number value in text (setq incNum (MM:trim-non-numerical-from-sides mainText) ; Set number as text with trimmed non-numeric values from sides position (vl-string-search incNum mainText) ; Set position where number starts prefixText (substr mainText 1 position) ; Set prefix as everything before number suffixText (substr mainText (1+ (+ position (strlen incNum))))) ; Set suffix as everything after number ;; ELSE (progn (setq position 2) ; Set position on second character (if (vl-string-search (substr mainText 1 1) "0123456789") ; Check if first character is number (setq prefixList (cons "No prefix" prefixList)) ; Add option with no prefix ) ; if end (while (<= position (strlen mainText)) ; While not end of string (if (and (vl-string-search (substr mainText position 1) "0123456789") ; Check if there's a number at current position (not (vl-string-search (substr mainText (1- position) 1) "0123456789"))) ; Check if there's not a number at previous position (setq prefixList (cons (substr mainText 1 (1- position)) prefixList)) ; Get prefix before current number ) (setq position (1+ position)) ; Go to next character in a string ) ; while end (setq userInput (car (AT:list-select prefixList))) ; Open dialog box with all possible prefixes and save user selection (if (= userInput "No prefix") ; Check if user selected "No prefix" option (else means that some prefix is selected) (setq prefixText "" ; Set prefix as nothing suffixText (vl-string-left-trim "0123456789" mainText) ; Set suffix as text without starting numbers incNum (vl-string-subst "" suffixText mainText)) ; Set number as part without suffix ;; ELSE (progn (setq prefixText userInput ; Set prefix as prefix selected by user suffixText (vl-string-left-trim "0123456789" (substr mainText (1+ (strlen prefixText)))) ; Set suffix as text without prefix and leading numbers incNum (substr mainText (1+ (strlen prefixText)) (- (strlen mainText) (strlen suffixText) (strlen prefixText)))) ; Set number as a part after prefix ) ) ; if end ) ; progn end ) ; if end (setq incStep 1) (while (progn (setvar 'errno 0) (initget "Step Undo Exit") (setq targetObject (entsel "\nSelect destination block [Step/Undo/Exit]: ")) (cond ((= 7 (getvar 'errno)) ; Check if clicked on background (princ "\nMissed, try again.") ) ; End of first condition ((= "Step" targetObject) ; Check if user want change step (while (progn (setq userInput (getstring (strcat "\nEnter increase step: "))) (cond ((and (vl-string-search (substr userInput 1 1) "-+0123456789") ; Check if first character is valid (MM:check-for-numbers "every" (substr userInput 2))) ; Check if rest of input is valid (setq incStep (atoi userInput)) nil ) ; End of second condition (t (princ "\nInvalid input, try again.")) ) ; cond end ) ; progn end ) ; while end T ; return 'true' ) ; End of second condition ((= "Undo" targetObject) ; Check if user want to undo last change (if changedEntities ; Check if there are any changed objects (progn (entmod (car changedEntities)) ; Change last changed object to its previous content (setq changedEntities (cdr changedEntities) ; Remove that object from a list of changed entities incNum (MM:increase-number '- incNum incStep)) ; Decrease number ) (princ "\nThere's no changes to undo.") ) ) ; End of third condition ((= "Exit" targetObject) ; Check if user want to exit (princ "\nNo more destination blocks selected. Exiting.") (exit) ) ; End of fourth condition ((or (= (cdr (assoc 0 (entget (car targetObject)))) "TEXT")(= (cdr (assoc 0 (entget (car targetObject)))) "MTEXT")) ; Check if text or mtext is chosen (vla-StartUndoMark activeDoc) (setq targetData (entget (car targetObject)) ; Get choosen objects data changedEntities (cons targetData changedEntities) ; Save content of target object (for future undoing) incNum (MM:increase-number '+ incNum incStep)) ; Increase number (entmod (subst (cons 1 (strcat prefixText incNum suffixText)) (assoc 1 targetData) targetData)) ; Change object content (vla-EndUndoMark activeDoc) T ) ; End of fifth condition (t (princ "\nInvalid selection, try again: ")) ) ; cond end ) ; progn end ) ; while end (setvar 'osmode osm) (setq *error* olderr) (princ) ) ; TNC end (defun LM:error ( msg ) ; by Lee Mac (if osm (setvar 'osmode osm)) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " msg)) ) ; if end (princ) ) ; LM:error end (defun MM:check-for-numbers ( amount targetStr ) ; Checks if string contains any or all numbers [any: amount == 'some'; all: amount == 'every'] (eval ((read (strcat "vl-" amount))(lambda (ch)(vl-string-search (chr ch) "0123456789"))(vl-string->list targetStr))) ) ; MM:check-for-numbers end (defun MM:trim-non-numerical-from-sides ( targetStr / start end len) ; Removes all leading and trailing non-numeric characters (setq start 1) ; Set start at first character (while (not (vl-string-search (substr targetStr start 1) "0123456789")) ; Check if character at current position is not a number (setq start (1+ start)) ; Increase position ) ; while end (setq end (strlen targetStr)) ; Set end at last character (while (not (vl-string-search (substr targetStr end 1) "0123456789")) ; Check if character at current position is not a number (setq end (1- end)) ; Decrease position ) ; while end (setq len (1+ (- end start))) (substr targetStr start len) ; Return string without trailing non-numerical characters ) ; MM:trim-non-numerical-from-sides end (defun MM:increase-number ( operator numStr step / num numLen strL zeros ) ; Increments number while keeping possible leading zeros (setq num (apply operator (list (atoi numStr) step))) ; Convert string to integer and increment (setq numLen (strlen (itoa num))) ; Length of the incremented number (setq strL (strlen numStr)) ; Original string length (if (> strL numLen) (setq zeros (repeat (- strL numLen) "0")) ; Calculate needed zeros (setq zeros "") ) ; if end (strcat zeros (itoa num)) ; Return concatenated zeros and number ) ; MM:increase-number end (defun LM:remove-rich-format ( str / _replace rx ) ; by Lee Mac (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) ; LM:remove-rich-format end (defun AT:list-select ( lst / longestString title label height width multi fileName openFile dialogObject userSelection dialogValue indexValue outputList ) ;; Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite) / 03.03.25 (remake by MM) ;; List Select Dialog (Temp DCL list box selection, based on provided list) (setq longestString (apply 'max (mapcar 'strlen lst))) ; Get the length of longest string in a list (setq title "Prefix List" ; title - list box title label "Select prefix:" ; label - label for list box height 20 ; height - height of the box width (if (< longestString 25) 30 (+ longestString 5)); width - width of the box multi "false" ; multi - selection method ["true": multiple, "false": single] lst (vl-sort lst '<)) ; lst - ascending list of strings to place in list box (setq openFile (open (setq fileName (vl-filename-mktemp "" "" ".dcl")) "w")) ; Open temporarily .dcl file for writing (foreach text_line (list (strcat "list_select : dialog { label = \"" title "\"; spacer;") (strcat ": list_box { label = \"" label "\";" "key = \"lst\";") (strcat "allow_accept = true; height = " (vl-princ-to-string height) ";") (strcat "width = " (vl-princ-to-string width) ";") (strcat "multiple_select = " multi "; } spacer; ok_cancel; }") ) ; DCL code for dialog (write-line text_line openFile) ; Open file and write line in it ) ; Iterate through all lines (close openFile) ; Close temporarily .dcl file (new_dialog "list_select" (setq dialogObject (load_dialog fileName))) (start_list "lst") (mapcar (function add_list) lst) (end_list) (setq userSelection (set_tile "lst" "0")) (action_tile "lst" "(setq userSelection $value)") (setq dialogValue (start_dialog)) (unload_dialog dialogObject) (vl-file-delete fileName) (if (= dialogValue 1) ; Check 'dialogValue' value ["0": Cancel, "1": OK] (progn (while (setq indexValue (vl-string-search " " userSelection)) ; Find space in string (for multiple selections) (setq outputList (cons (nth (atoi (substr userSelection 1 indexValue)) lst) outputList)) ; Find element (based on index) in original string and store it in output list (setq userSelection (substr userSelection (+ 2 indexValue))) ; Remove processed part of the string ) ; while end (reverse (cons (nth (atoi userSelection) lst) outputList)) ; Add last element and return reversed list ) ; progn end ) ; if end ) ; AT:list-select end (princ "\n CustomIncrement.lsp - \"TNC\" to select object, pick which part to increase, pick incremental step, and then click to paste and generate.") (princ) This is my first "bigger" AutoLISP script so if someone has some suggestions for improving the code I am more than welcome to take them because there's for sure much that can be done better. Also big thanks to @Lee Mac on creating script for 'UnFormat String' that I'm using in my script (it's called 'remove-rich-format' in my script just because it looks nicer to me) and on this tutorial on error handling (not sure if I got it right, but I tried ), as much as on all other he created that I was learning from and on which I will continue learning - you are legend. And also big thanks to Alan J. Thompson for creating 'List Select Dialog' that I'm also using in my script.

Also, the conditional clause 'cond' '(eq objType "LWPOLYLINE")' works with "POLYLINES" but not with "LWPOLYLINES". So your code will fail there.

(defun normalize (vec / len) (if (> (setq len (distance '(0 0) vec)) 1e-9) (list (/ (car vec) len) (/ (cadr vec) len)) vec ) )

Hi Nikon The problem is that 'let' not is a function defined by the language or by you. You should either redefine the 'normalize' function so that it does not use this function or define it yourself. The easiest is the first one

It Works! Yay! Thank you very much! But it takes looooong time to process all data - , and ends up with just the spinning wheel so I can't even save when it's finished. I even left it over night, but that didn't help - some kind of overflow? I guess I have to divide the data up in smaller parts and run them one by one... But it works, and that's what matters.

As already mentioned, when you pick a blank spot on the dwg you will get nil returned, so can then pop a choice exit or change step. I use my Multi radio buttons as below its here in Downloads, you can use Acet-yes--no where yes would mean set Step, no is Exit, You can use initget "Exit Step". Yes I do use this method when asking to add to a table or start a new one. Ps (exit) will do just that a built in lisp function.

The problem, I think, is that 'entsel' is not suitable for what you need. Because the value that 'entsel' can deposit in 'targetObject' can only be a list '(entity_name point)' or 'nil'. That is: it can never be "", nor "Step" nor "Exit"

I wrote a reactor lisp that trapped close and save and did stuff, sounds like something similar, @GLAVCVS has hinted where to look, in Acad there are like 4 places code can be loaded from, Acaddoc.lsp, acad.lsp, Appload start up suite, mnl files. Not sure about Progecad, Do a GOOGle find out where files can be loaded from on start up.