Incrementing text of format P1/L1/D1

[peter]

Someone asked me a question via private message about how to increment text in the format P1/L1/D1 to P1/L1/D2

I included two functions the first that allows changing any of the three integers with any increment
and the other to change just the third part up one.

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.
;___________________________________________________________________________________________________________|
;
; Abstract: This library is to increment text in a string of the form P1/L1/D1
;___________________________________________________________________________________________________________|
;
; Command Line Function Header List
;___________________________________________________________________________________________________________|

;* C:INCP
;* Command Line Function to increment text with syntax "P1/L1/D1"

;* C:IncrementPart
;* Command Line Function to increment text with syntax "P1/L1/D1"

;* C:INCP1
;* Command Line Function to increment 1 the D text with syntax "P1/L1/D1"

;* C:IncrementPartOne
;* Command Line Function to increment 1 the D text with syntax "P1/L1/D1"

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

;  Function, Arguments and Description

;* (CSVStringToList  strText strChar )
;* Convert CSV String to List

;* (ListFlatten lstSublist)
;* Function to flatten a list of sublists into a list of atoms

;* (ListToCSVString lstSublist strChar)
;* Function to Convert List to CSV String

;* (IncrementPart objSelection intPosition intIncrement)
;* Function to increment text object string at 0, 1 or 2 position for increment value

;$ Header End

;___________________________________________________________________________________________________________ 
;
; Command Line Function to increment text with syntax "P1/L1/D1"
;___________________________________________________________________________________________________________

(defun C:INCP ()(C:IncrementPart))

(defun C:IncrementPart (/ blnRun entSelection intIncrement intPosition lstPositions 
                          lstSelection objSelection strInteger strKeyWord)
 (if (and
      (progn (initget 8 "P L D") T)
      (or (setq strKeyword (getkword "\nEnter P L or D <D>: "))
          (setq strKeyword "D")
      )
      (progn (initget 8) T)
      (or (setq intIncrement (getint "\nEnter Increment <1>: "))
          (setq intIncrement 1)
      )
      (setq lstPositions (list (list "P" 0)(list "L" 1)(list "D" 2)))
      (setq intPosition  (cadr (assoc strKeyword lstPositions)))
      (setq blnRun T)
     )
  (while blnRun
   (if (and (setq lstSelection   (entsel "\nSelect Text: "))
            (setq entSelection   (car lstSelection))
            (setq objSelection   (vlax-ename->vla-object entSelection))
       )
    (IncrementPart objSelection intPosition  intIncrement)
   )
  )
 )
 (princ)
)


;___________________________________________________________________________________________________________ 
;
; Command Line Function to increment 1 the D text with syntax "P1/L1/D1"
;___________________________________________________________________________________________________________

(defun C:INCP1 ()(C:IncrementPartOne))

(defun C:IncrementPartOne (/ blnRun entSelection lstSelection objSelection )
 (if (and
      (setq blnRun T)
     )
  (while blnRun
   (if (and (setq lstSelection   (entsel "\nSelect Text: "))
            (setq entSelection   (car lstSelection))
            (setq objSelection   (vlax-ename->vla-object entSelection))
       )
    (IncrementPart objSelection 2 1)
   )
  )
 )
 (princ)
)


;___________________________________________________________________________________________________________ 
;
; Convert CSV String to List **
;___________________________________________________________________________________________________________ 

(defun CSVStringToList  (strText strChar / intPosition lstStrings)
 (while (setq intPosition (vl-string-search strChar strText 0))
  (setq lstStrings  (cons (substr strText 1 intPosition) lstStrings)
        strText     (substr strText (+ intPosition 1 (strlen strChar)))
  )
 )
 (if lstStrings
  (reverse (cons strText lstStrings))
  (list strText)
 )
)


;___________________________________________________________________________________________________________ 
;
; Function to flatten a list of sublists into a list of atoms
;___________________________________________________________________________________________________________

(defun ListFlatten (lstSublist)
 (if (= (type lstSublist) 'LIST)
  (progn
   (if (or (not (cdr lstSublist))
       (= (type (cdr lstSublist)) 'LIST))
    (setq lstSublist lstSublist)
    (setq lstSublist (list (car lstSublist)(cdr lstSublist))) 
   )
   (apply 'append (mapcar 'listFlatten lstSublist))
  )
  (list lstSublist)  
 )
)


;___________________________________________________________________________________________________________
; 
; Function to Convert List to CSV String
;___________________________________________________________________________________________________________

(defun ListToCSVString (lstSublist strChar / lstOfSublists)
 (if (and
      (> (length lstSublist) 0)
      (setq lstSublist    (mapcar 'vl-princ-to-string lstSublist))
      (setq lstOfSublists (mapcar '(lambda (X)(list strChar X)) lstSublist))
      (setq lstSublist    (listflatten lstOfSublists))
     )
  (apply 'strcat (cdr lstSublist))
 )
)

;___________________________________________________________________________________________________________ 
;
; Function to increment text object string at 0, 1 or 2 position for increment value
;___________________________________________________________________________________________________________

(defun IncrementPart (objSelection intPosition intIncrement / 
                      lstTextStrings strInteger strPart strTextString)
 (if (and (= (vla-get-objectname objSelection) "AcDbText")
          (setq strtextString  (vla-get-textstring objSelection))
          (setq lstTextStrings (csvstringtolist strTextString "/"))
          (= (length lstTextStrings) 3)
          (setq strPart        (nth intPosition lstTextStrings))
          (setq strInteger     (substr strPart 2))
          (setq strInteger     (itoa (+ intIncrement (atoi strInteger))))
          (setq lstTextString  (subst (strcat (substr strPart 1 1) strInteger) strPart lstTextStrings))
          (setq strTextString  (listtocsvstring lstTextString "/"))
          (setq strTextString  (strcase strTextString))
      )
  (progn (vla-put-textstring objSelection strTextString) T)
  (setq blnRun nil)
 )
)



(princ "!")

(vl-load-com)

[gazze82768741]

Many thanks for such a prompt reply Peter, and thank you for your time.

I have just tried each of the options but all seem to return the following:

Command: INCREMENTPARTONE
Select Text: ; error: no function definition: LISTFLATTEN

I hope that this make sense? I am using Autocad 2018

Regards,

Gary

[peter]

I added ListFlatten to the function, so download it again and it should work.

This happens because I am stealing toolbox functions that are interrelated and sometimes I forget to put a function or two in there.

Peter

[gazze82768741]

Peter,

This is working great now Thank you very much.

Just one other thing, would it be possible to apply this increment to a whole selection instead of having to click each individual text?

Again many thanks for the time you are taking looking at this.

Gary.

[peter]

The function IncrementPart could be called from a function iterating through a selection set (see below)

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.
;___________________________________________________________________________________________________________|
;
; Abstract: This library is to increment a text string of the form P1/L1/D1
;___________________________________________________________________________________________________________|
;
; Command Line Function Header List
;___________________________________________________________________________________________________________|

;* C:INCP
;* Command Line Function to increment text with syntax "P1/L1/D1"

;* C:IncrementPart
;* Command Line Function to increment text with syntax "P1/L1/D1"

;* C:INCPS
;* Command Line Function to increment the each text with syntax "P1/L1/D1" by selection set

;* C:IncrementParts
;* Command Line Function to increment the each text with syntax "P1/L1/D1" by selection set

;* C:INCP1
;* Command Line Function to increment 1 the D text with syntax "P1/L1/D1"

;* C:IncrementPartOne
;* Command Line Function to increment 1 the D text with syntax "P1/L1/D1"

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

;  Function, Arguments and Description

;* (CSVStringToList  strText strChar )
;* Convert CSV String to List

;* (IncrementPart objSelection intPosition intIncrement)
;* Function to increment text object string at 0, 1 or 2 position for increment value

;* (ListFlatten lstSublist)
;* Function to flatten a list of sublists into a list of atoms

;* (ListToCSVString lstSublist strChar)
;* Function to Convert List to CSV String


;$ Header End

;___________________________________________________________________________________________________________ 
;
; Command Line Function to increment text with syntax "P1/L1/D1"
;___________________________________________________________________________________________________________

(defun C:INCP ()(C:IncrementPart))

(defun C:IncrementPart (/ blnRun entSelection intIncrement intPosition lstPositions 
                          lstSelection objSelection strInteger strKeyWord)
 (if (and
      (progn (initget 8 "P L D") T)
      (or (setq strKeyword (getkword "\nEnter P L or D <D>: "))
          (setq strKeyword "D")
      )
      (progn (initget 8) T)
      (or (setq intIncrement (getint "\nEnter Increment <1>: "))
          (setq intIncrement 1)
      )
      (setq lstPositions (list (list "P" 0)(list "L" 1)(list "D" 2)))
      (setq intPosition  (cadr (assoc strKeyword lstPositions)))
      (setq blnRun T)
     )
  (while blnRun
   (if (and (setq lstSelection   (entsel "\nSelect Text: "))
            (setq entSelection   (car lstSelection))
            (setq objSelection   (vlax-ename->vla-object entSelection))
       )
    (IncrementPart objSelection intPosition  intIncrement)
   )
  )
 )
 (princ)
)

;___________________________________________________________________________________________________________ 
;
; Command Line Function to increment the each text with syntax "P1/L1/D1" by selection set
;___________________________________________________________________________________________________________

(defun C:INCPS ()(C:IncrementParts))

(defun C:IncrementParts (/ entSelection intCount intIncrement intPosition
                                     lstPositions objSelection ssSelections strKeyWord )
 (if (and
      (progn (initget 8 "P L D") T)
      (or (setq strKeyword (getkword "\nEnter P L or D <D>: "))
          (setq strKeyword "D")
      )
      (progn (initget 8) T)
      (or (setq intIncrement (getint "\nEnter Increment <1>: "))
          (setq intIncrement 1)
      )
      (setq lstPositions (list (list "P" 0)(list "L" 1)(list "D" 2)))
      (setq intPosition  (cadr (assoc strKeyword lstPositions)))
      (princ "\nSelect Text: ")
      (setq ssSelections (ssget (list (cons 0 "*text"))))
     )
  (repeat (setq intCount (sslength ssSelections)) 
   (and (setq intCount (1- intCount))
        (setq entSelection   (ssname ssSelections intCount))
        (setq objSelection   (vlax-ename->vla-object entSelection))
        (IncrementPart objSelection intPosition  intIncrement)
   )
  )
 )
 (princ)
)


;___________________________________________________________________________________________________________ 
;
; Command Line Function to increment 1 the D text with syntax "P1/L1/D1"
;___________________________________________________________________________________________________________

(defun C:INCP1 ()(C:IncrementPartOne))

(defun C:IncrementPartOne (/ blnRun entSelection lstSelection objSelection ) 
 (if (and 
      (setq blnRun T)
     )
  (while blnRun
   (if (and (setq lstSelection   (entsel "\nSelect Text: "))
            (setq entSelection   (car lstSelection))
            (setq objSelection   (vlax-ename->vla-object entSelection))
       )
    (IncrementPart objSelection 2 1)
   )
  )
 )
 (princ)
)


;___________________________________________________________________________________________________________ 
;
; Convert CSV String to List **
;___________________________________________________________________________________________________________ 

(defun CSVStringToList  (strText strChar / intPosition lstStrings)
 (while (setq intPosition (vl-string-search strChar strText 0))
  (setq lstStrings  (cons (substr strText 1 intPosition) lstStrings)
        strText     (substr strText (+ intPosition 1 (strlen strChar)))
  )
 )
 (if lstStrings
  (reverse (cons strText lstStrings))
  (list strText)
 )
)

;___________________________________________________________________________________________________________ 
;
; Function to increment text object string at 0, 1 or 2 position for increment value
;___________________________________________________________________________________________________________

(defun IncrementPart (objSelection intPosition intIncrement / 
                      lstTextStrings strInteger strPart strTextString)
 (if (and (= (vla-get-objectname objSelection) "AcDbText")
          (setq strtextString  (vla-get-textstring objSelection))
          (setq lstTextStrings (csvstringtolist strTextString "/"))
          (= (length lstTextStrings) 3)
          (setq strPart        (nth intPosition lstTextStrings))
          (setq strInteger     (substr strPart 2))
          (setq strInteger     (itoa (+ intIncrement (atoi strInteger))))
          (setq lstTextString  (subst (strcat (substr strPart 1 1) strInteger) strPart lstTextStrings))
          (setq strTextString  (listtocsvstring lstTextString "/"))
          (setq strTextString  (strcase strTextString))
      )
  (progn (vla-put-textstring objSelection strTextString) T)
  (setq blnRun nil)
 )
)

;___________________________________________________________________________________________________________ 
;
; Function to flatten a list of sublists into a list of atoms
;___________________________________________________________________________________________________________

(defun ListFlatten (lstSublist)
 (if (= (type lstSublist) 'LIST)
  (progn
   (if (or (not (cdr lstSublist))
       (= (type (cdr lstSublist)) 'LIST))
    (setq lstSublist lstSublist)
    (setq lstSublist (list (car lstSublist)(cdr lstSublist))) 
   )
   (apply 'append (mapcar 'listFlatten lstSublist))
  )
  (list lstSublist)  
 )
)

;___________________________________________________________________________________________________________
; 
; Function to Convert List to CSV String
;___________________________________________________________________________________________________________

(defun ListToCSVString (lstSublist strChar / lstOfSublists)
 (if (and
      (> (length lstSublist) 0)
      (setq lstSublist    (mapcar 'vl-princ-to-string lstSublist))
      (setq lstOfSublists (mapcar '(lambda (X)(list strChar X)) lstSublist))
      (setq lstSublist    (listflatten lstOfSublists))
     )
  (apply 'strcat (cdr lstSublist))
 )
)

(princ "!")

(vl-load-com)

[gazze82768741]

You are a gentlemen!!!

Works a treat, thank you so much Peter!