(HELP) Need a LISP - Attribute increments

[ECASAOL350033]

Hey all,

Pretty new to the Lisp routine game.
I need a lisp routine that will increment my attributes within a block by just setting a base number eg 123456. then as i click on each block the attribute associated with that block will increment by 1 (or as many as i choose).
I also need to be able to select which attribute will be altered (incrimented) as my blocks have multiple attributes.

If any Lisp wizards out there can dumb it down for me it would be appriciated.

Ive tried creating one from scratch but its pretty hopeless...

Thanks a lot!!!

Rico

[pbejse]

Welcome to the forum Rico

(Defun c:ati (/ startnumber limit
                nestedobjsectselectionmode
                entitydata
                selectedentitytype
                attributeValuetobereplace
                )
;;;; 			dumbed down as per your request			;;;
      (while (not (progn
  		(setq startnumber (getstring "\nEnter Start number: "))
  		(if (and (numberp (setq limit (read startnumber)))
								(<= 1 limit 100000))
                limit
                    (and (princ "\n<Invalid number>") nil)))))
      (while (setq nestedobjsectselectionmode (car (nentsel "\nSelect Attribute/Enter to exit:")))
             (setq entitydata (entget nestedobjsectselectionmode))
             (setq selectedentitytype (cdr (assoc 0 entitydata)))
             (if (eq selectedentitytype "ATTRIB")
                 (progn
                       (setq attributeValuetobereplace (assoc 1 entitydata))
                       (entmod (subst (cons 1
                                            (strcat "C" (itoa limit)))
                                      attributeValuetobereplace
                                      entitydata))
                       (setq limit (+ 1 limit))
                             )
                 (princ "\nNot an attribute definition"))
            )
      (princ)
      )

HTH

EDIT: Modified as per request

[ECASAOL350033]

thank you so much!

just to be a pain in the a$$...

is there a way to add a prefix? eg. C123456
though i dont need to change the prefix in anyway.

also, can the amount be changed from between 1 and 32767 to 1 and 100000?

thanks again pbejse!!

[pbejse]

is there a way to add a prefix? eg. C123456
though i dont need to change the prefix in anyway.

also, can the amount be changed from between 1 and 32767 to 1 and 100000?

thanks again pbejse!!

Done! see previous post for modified code

Hope this helps.

Cheers

[SimonB]

I realise this is quite old now, but would it be possible to add a prompt for the prefix so that the user can define is/her own prefix to the counter?

****Update****

13/07/2015

I've worked it out myself now, all it needed was a Getstring function & a new variable
- Simon

[BOLGERDESIGN766545]

Can the following code be changed to start with zeros before the first numbers, Ex. P-001, P-002 etc... Once P-100 is reached it would continue with P-101 etc...Thanks in advance!

Welcome to the forum Rico

(Defun c:ati (/ startnumber limit
                nestedobjsectselectionmode
                entitydata
                selectedentitytype
                attributeValuetobereplace
                )
;;;; 			dumbed down as per your request			;;;
      (while (not (progn
  		(setq startnumber (getstring "\nEnter Start number: "))
  		(if (and (numberp (setq limit (read startnumber)))
								(<= 1 limit 100000))
                limit
                    (and (princ "\n<Invalid number>") nil)))))
      (while (setq nestedobjsectselectionmode (car (nentsel "\nSelect Attribute/Enter to exit:")))
             (setq entitydata (entget nestedobjsectselectionmode))
             (setq selectedentitytype (cdr (assoc 0 entitydata)))
             (if (eq selectedentitytype "ATTRIB")
                 (progn
                       (setq attributeValuetobereplace (assoc 1 entitydata))
                       (entmod (subst (cons 1
                                            (strcat "C" (itoa limit)))
                                      attributeValuetobereplace
                                      entitydata))
                       (setq limit (+ 1 limit))
                             )
                 (princ "\nNot an attribute definition"))
            )
      (princ)
      )

HTH

EDIT: Modified as per request

[BIG-AL]

You need to look at is less than 100 then less than 10 and add 0 or 00 here is an example.

; if less than 10
(if (< (car dwgnum) 10.0) 
      (setq newstr2 (strcat dwgname "-D0"  (rtos sheetnum 2 0)))
      (setq newstr2 (strcat dwgname "-D"  (rtos sheetnum 2 0)))
)

[peter]

Fun... or at least I had fun writing this....

I include two functions that will increment attributes.

The first AtInc will increment one attribute by selecting the attribute.

It will ignore text characters and increment numbers using a 1 integer (can be changed to prompt for other values)

The second AtsInc will increment the first attributes in multiple selected blocks (ignoring letters so you can have prefixes etc...)

P=

;___________________________________________________________________________________________________________|
;
; Written By: Peter Jamtgaard C.E., P.E., S.E. copyright 2018 All Rights Reserved
;___________________________________________________________________________________________________________|
;
; Any use by unauthorized person or business is strictly prohibited.
; Include Shorthand.lsp
;___________________________________________________________________________________________________________|

;___________________________________________________________________________________________________________|
;
; Command Line Function Header List
;___________________________________________________________________________________________________________|

;* C:AtInc
;* Command line function to increment a selected attribute 

;* C:AttributeIncrement
;* Command line function to increment a selected attribute 

;* C:AtsInc
;* Command line function to increment attributes in selected blocks 

;* C:AttributesIncrement
;* Command line function to increment attributes in selected blocks

;___________________________________________________________________________________________________________|
;
; General Function Header List
;___________________________________________________________________________________________________________|

;  Function List Argument1 Argument2 Arguement3

;* (AttributeFromBlock objAttribute)
;* Function to check if attribute or block with attribute and return attribute

;* (AttributeIncrement objAttribute intIncrement)
;* Function to increment an attribute with a value intIncrement

;* (IsAsciiNumeral intAscii)
;* Function to text an Ascii value to see if it a numeral or decimal place

;* (SelectionSetToList ssSelections)
;* Function to convert a entity based selection set to a list

;* (TextIncrement strTextString intIncrement)
;* Function to increment a textstring with a value intIncrement

;* (TextNumeralParse strTextString)
;* Function to parse a string and separate letters and numerals in groups and return a list of strings.

;$ End Header

;___________________________________________________________________________________________________________|
; 
; Command line function to increment an attribute 
;___________________________________________________________________________________________________________|

(defun C:AtInc ()(C:AttributeIncrement))

(defun C:AttributeIncrement (/ entSelection intIncrement lstSelection objAttribute)
 (while (and ;(setq intIncrement (getint "\nEnter Increment Value: "))
             (setq intIncrement 1)
             (setq lstSelection  (nentsel "\nSelect Attribute: "))
             (setq entSelection  (car lstSelection))
             (setq objAttribute  (vlax-ename->vla-object entSelection))
             (wcmatch (vla-get-objectname objAttribute) "AcDbAttribute")
        )
  (AttributeIncrement objAttribute 1)
 )
 (prin1)
)

 



;___________________________________________________________________________________________________________|
; 
; Command line function to increment attributes in selected blocks 
;___________________________________________________________________________________________________________|

(defun C:AtsInc ()(C:AttributesIncrement))

(defun C:AttributesIncrement (/  intIncrement lstSelections ssSelections)
 (if (and ;(setq intIncrement (getint "\nEnter Increment Value: "))
          (setq intIncrement 1)
          (princ "\nSelect Blocks: ")
          (setq ssSelections  (ssget (list (cons 0 "insert"))))
          (setq lstSelections (SelectionSetToList ssSelections))
     )
  (mapcar '(lambda (X)(AttributeIncrement X intIncrement)) lstSelections)
 )
 (prin1)
)

;___________________________________________________________________________________________________________|
; 
; Function to check if attribute or block with attribute and return attribute
;___________________________________________________________________________________________________________|

(defun AttributeFromBlock (objAttribute / lstAttributes)
 (if (or (wcmatch (vla-get-objectname objAttribute) "AcDbAttribute")
         (and (wcmatch (vla-get-objectname objAttribute) "AcDbMInsertBlock,AcDbBlockReference")
              (= (vlax-get objAttribute "HasAttributes") -1)
              (setq lstAttributes (vlax-invoke objAttribute "getattributes"))
              (setq objAttribute  (car lstAttributes))
         )
     )
  objAttribute
 )
)

;___________________________________________________________________________________________________________|
; 
; Function to increment an attribute with a value intIncrement
;___________________________________________________________________________________________________________|

(defun AttributeIncrement (objAttribute intIncrement / sngTextString strTextString)
 (if (and (setq objAttribute   (AttributeFromBlock objAttribute))
          (setq strTextString  (vla-get-textstring objAttribute))
          (setq lstTextStrings (TextNumeralParse strTextString))
          (setq lstTextStrings (mapcar '(lambda (X) (TextIncrement X 1)) lstTextStrings))
          (setq lstTextStrings (vl-remove nil lstTextStrings))
          (setq lstTextStrings (vl-remove "" lstTextStrings))
          (setq strTextString  (apply 'strcat lstTextStrings))
     )
  (progn (vla-put-textstring objAttribute strTextString) T) 
 )
)

;___________________________________________________________________________________________________________|
;
; Function to text an Ascii value to see if it a numeral or decimal place.
;___________________________________________________________________________________________________________|

(defun IsAsciiNumeral (intAscii)
 (and (member intAscii (vl-string->list ".0123456789")))
)


;___________________________________________________________________________________________________________ 
;
; Function to convert a entity based selection set to a list.
;___________________________________________________________________________________________________________

(defun SelectionSetToList (ssSelections / entSelection intCount lstObjects objSelection )
 (repeat (setq intCount (sslength ssSelections))
  (setq intCount (1- intCount))
  (setq entSelection (ssname ssSelections intCount))
  (setq objSelection (vlax-ename->vla-object entSelection))
  (setq lstObjects   (cons objSelection lstObjects))
 )
 lstObjects
)

;___________________________________________________________________________________________________________|
; 
; Function to increment a textstring with a value intIncrement
;___________________________________________________________________________________________________________|

(defun TextIncrement (strTextString intIncrement / sngTextString)
 (if (and (apply 'and (mapcar 'IsAsciiNumeral (vl-string->list strTextString)))
          (or (and (vl-string-search "." strTextString)
                   (setq sngTextString (atof strTextString))
              )
              (setq sngTextString (atoi strTextString))
          )
          (setq sngTextString (+ sngTextString intIncrement))
     )
  (setq strtextString (vl-princ-to-string sngTextString))
  strTextString
 )
)


;___________________________________________________________________________________________________________|
;
; Function to parse a string and separate letters and numerals in groups and return a list of strings.
;___________________________________________________________________________________________________________|

(defun TextNumeralParse (strTextString / intAsciiOld intAsciiOld lstOfAsciiValues lstSublist)
 (if (= (type strTextString) 'LIST)
  (setq strTextString (car strTextString))
 )
 
 (foreach intAscii (vl-string->list strTextString)
  (or (and (or (= (IsAsciiNumeral intAscii)
                  (IsAsciiNumeral intAsciiOld)    
               )
               (not intAsciiOld)
           )
           (setq lstSublist  (cons intAscii lstSublist))
      )
      (and 
           (setq lstOfAsciiValues (cons (reverse lstSublist) lstOfAsciiValues))
           (setq lstSublist (list intAscii))
      )      
  ) 
  (setq intAsciiOld intAscii)
 )
 (setq lstOfAsciiValues (cons (reverse lstSublist) lstOfAsciiValues))
 (mapcar 'vl-list->string (reverse lstOfAsciiValues))
)

(vl-load-com)

[gazze82768741]

Hi all,

Is it possible to modify so that I can increment a range of Text or MText lines?

So basically, I have a set of values ie P1/L1/D1, P1/L1/D2, P1/L1/D3 to P1/L1/D100 etc... I now need to increment the last value (D) by +1 as I have added another ident, shifting the ones following them. In the past I have just been moving the text to the next symbol manually, but when you can sometimes have 70 to move them is a bit of a task!

I hope you can help as I have been trying to find a simple solution for a while now, but only the following from 1996! has been close. The issue with this is that it increments the "P" value and not "D".

(defun C:INC (/ ; Functions & Variables
; Functions
val put r_fill getdp at
; Variables
ss inc i l e j k ascii_nr string newstring nr count dp1 dp
OldStation dp_pos end_pos
)
;=============================
; Entity assoc list utilities
;-----------------------------
(defun val (nr e) (cdr (assoc nr e)))
(defun put (x nr e)(subst (cons nr x) (assoc nr e) e))
;;; ================================================== ========================
;;; Function: AT
;;; Purpose : Returns the position of the first occurance of a string
;;; or NIL if not found
;;; Params : string String to search
;;; char String to locate
;;;
;;; Uses : 
;;; --------------------------------------------------------------------------
(defun at (string char / i len clen)
(if string
(progn
(setq i 1 len (strlen string) clen (strlen char))
(while (and (<= i len) (/= (substr string i clen) char))
(setq i (1+ i))
)
(if (> i len)
(setq i nil)
)
(eval i)
)
)
)
;;; ================================================== ========================
;;; Function: R_FILL <string> <len>
;;; Purpose : Returns a string filled with spaces on the right
;;;
;;; Params : string String to fill
;;; len String length
;;;
;;; --------------------------------------------------------------------------
(defun r_fill (s len / space i)
(setq space "" i (- len (strlen s)))
(if (> i 0)
(substr (strcat s (repeat i (setq space (strcat space " ")))) 1 len)
s
)
)
;; Return number of decimal places of a REAL
(defun getdp (nr / n)
(setq n 0 nr (abs nr))
(while (null (equal (fix (+ nr 0.5)) nr 0.000001))
(setq n (1+ n))
(setq nr (* nr 10))
)
n
)
;;; ================================================== ========================
;-- Start C:TEXTINC
(setvar "CMDECHO" 0)
(princ "\nSelect TEXT containing NUMBERS to increment.")
(if (and
(setq ss (ssget '((0 . "*TEXT"))))
(setq inc (getreal "\nIncrement: "))
(/= inc 0)
)
(progn
(setq i 0 l (sslength ss) count 0)
(while (< i l)
(setq e (entget (ssname ss i)))
(setq string (val 1 e))
;; --- Check for an number ---
(if (and 
(wcmatch string "*[0-9]*") ; Find an INT
; (wcmatch string "~*#.#*") ; No REALs
(wcmatch string "~*%%d*") ; No BEARINGS
)
(progn
(setq count (1+ count))
(setq j 1 k (strlen string))
(if (wcmatch string "*#+##*") ; Check for Station
(setq
OldStation string
j (at string "+")
string (strcat
(substr string 1 (1- j))
(substr string (1+ j))
)
j 1
k (strlen string)
)
)
;; --- Step though the string looking
;; --- for the first int ---
(while (<= j k)
(setq ascii_nr (ascii (substr string j 1)))
(if (and (>= ascii_nr 48)(<= ascii_nr 57))
(progn
(setq end_pos j)
(while (or (= ascii_nr 46)(and (>= ascii_nr 48)(<= ascii_nr 57)))
(setq
end_pos (1+ end_pos)
ascii_nr (ascii (substr string end_pos 1))
)
)
(setq
dp_pos (at (substr string j) ".")
nr (atof (substr string j))
dp1 (if dp_pos (- end_pos dp_pos j) 0)
dp (max dp1 (getdp inc))
nr (+ nr inc)
newstring (strcat 
(substr string 1 (1- j))
(rtos nr 2 dp)
(substr string end_pos)
)
j k ;; Now exit
)
)
)
(setq j (1+ j))
)
;; If station then insert the "+"
(if OldStation
(progn
(setq string Oldstation)
(if (setq j (at newstring "."))
(setq j (- j 3))
(setq j (- (strlen newstring) 2))
)
(setq newstring
(strcat (substr newstring 1 j) "+"
(substr newstring (1+ j))
)
)
)
)
;; --- Echo changes to screen ---
(princ (strcat "\n" (r_fill string 12) "--> " newstring))
;; --- Update the TEXT entity ---
(entmod (put newstring 1 e))
)
(princ (strcat "\nNo Numeric value: " string))
)
(setq i (1+ i))
)
(princ (strcat "\n" (itoa count) " TEXT number\(s\) incremented."))
)
(princ "\nTEXTINC cancelled.")
)
(princ)
)
(princ "\nTEXTINC.LSP v1.22")
(princ)