Lisp to increment letters with prefix or suffix

[Tharwat]

Incrementing by number is much more simpler than letters so try the following mods and let me know.

(defun c:IncAtt (/ int sel ent get lst fun opr tmp pre key)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and
    (or (initget "X Y")
        (setq key
               (getkword
                 "\nSpecify direction of attributed blocks to increment alphabatically [ X / Y ] : "
               )
        )
    )
    (setq pre (getint "\nEnter The Numbering Starting Value :"))
    (princ "\nSelect Attributed blocks with ORDER attribute to increment : ")
    (setq int -1
          sel (ssget "_:L" '((0 . "INSERT") (66 . 1)))
    )
    (while (setq int (1+ int)
                 ent (ssname sel int)
           )
      (setq get (entget ent)
            lst (cons (list (cdr (assoc 10 get)) ent) lst)
      )
    )
    (if (= key "X")
      (setq fun car
            opr <
      )
      (setq fun cadr
            opr >
      )
    )
    (mapcar
      (function
        (lambda (obj)
          (setq obj (cadr obj))
          (while
            (/=
              (cdr (assoc 0 (setq get (entget (setq obj (entnext obj)))))
              )
              "SEQEND"
            )
             (if (= (cdr (assoc 2 get)) "ORDER")
               (and (entmod (subst (cons 1 (itoa pre)) (assoc 1 get) get))
                    (setq pre (1+ pre))
               )
             )
          )
        )
      )
      (vl-sort
        lst
        (function (lambda (j k) (opr (fun (car j)) (fun (car k)))))
      )
    )
  )
  (princ)
) (vl-load-com)

 

[Steven P]

32 minutes ago, Tharwat said:

Incrementing by number is much more simpler than letters so try the following mods and let me know.

 

 

I can see that the next question is going to be either increment by numbers or by letters.

 

This didn't work for me when I checked using the OPs example.

[Tharwat]

15 minutes ago, Steven P said:

 

I can see that the next question is going to be either increment by numbers or by letters.

I have no problem to help any one asks me as long as I have the time besides the willing.

 

19 minutes ago, Steven P said:

 

This didn't work for me when I checked using the OPs example.

 

Follow the thread before you criticize and blame the others.

 

[Steven P]

It is not a criticism of the help you are giving the OP, which like many on here is great - we have all learnt from the help of others. Just saying that this didn't work for me and time constraints of work and projects today didn't let me work out why earlier (which is a far more valuable thing to tell you). All I know is when I tried your latest code and the OPs sample, it didn't work. Might be something I did wrong, might be something in the code, I haven't worked it out yet.

 

 

Further up in the thread I made a comment that making the code more versatile for others to follow could be a good thing. Here having the code able to increment numbers and letters would make it more versatile for others to follow. The OPs first example was letters, now asking for numbers, I suspect they actually want both.

[Tharwat]

As I said you are not following, the member who asked for number incrementing codes is different that the OP and they have different tag name as they already claimed that in their earlier replies.

 

[Steven P]

Fair enough, I wasn't looking at the names, just the content of the question. I'll let you play with this one. My comment will be the same though, the code didn't work for me - not sure why, and that it would be more versatile to do both letters and numbers, and that would make for a better routine.

[Tharwat]

Helping others does not mean 'a play' to me if that's your opinion , so if you are after that program then come and pay for it and I will make it for you unless you are like that guy who is messing up with all threads for the sake of number of posts.

Don't be panic from my frankness because I can't say other than what I believe.

[BIGAL]

A mixture of numbers and alpha can be handled in a different way but it becomes horribly complex if we look at "AB1" we can split it into A B 1 so could add to the "1" and make a new "AB2".

 

"A1B" becomes A 1 B so next will be "A1C" but what happens when we get to "A1Z" ? Or is "A2B" the correct answer.

 

Really depends on the OP request so a simple global answer may not be forthcoming. The all Alpha answer as I suggested by Gile works great.

[aridzv]

@Tharwat

hi and sorry for the late reply.

20 hours ago, Tharwat said:

Incrementing by number is much more simpler than letters so try the following mods and let me know.

PERFECT - THANKS!!

your code solved me a long standing issue.

regards,

aridzv.

Edited September 17, 2022 by aridzv

[aridzv]

@Steven P

20 hours ago, Steven P said:

 

I can see that the next question is going to be either increment by numbers or by letters.

@Tharwat made those 2 functions already. 

It's easy enough to use both functions as separate commands.

topics,obvisuly,are evolving and it is natural that new questions and needs will arise as a result, so I am not entirely clear about the resentment you are expressing.

 

 

20 hours ago, Steven P said:

This didn't work for me when I checked using the OPs example.

Strange, for me both functions worked.

At first I used the example file of the OP and the original function and it worked perfectly, and the other function also worked perfectly for me, and all this when I use Bricsad and occasionally there are small incompatibilities between Autocad and Bricsad lisp code, but not in this case.

Edited September 17, 2022 by aridzv

[Tharwat]

18 minutes ago, aridzv said:

Strange, for me both functions worked.

No wonder, because you are having the tag name ORDER and the drawing attached from the OP has different tag name.

[aridzv]

Hi @Tharwat.

after a long time, I have a question about the lisp:

is it possible to give every block type in the drawing the same number?

let say that I have 4 types of blocks and each of them appears several times.

I need that each block type will get the same number.

I attached a sample drawing with the needed resault along with the screen shot here.

thanks,

aridzv.

 

*edit:

I thought about using VL-SORT function,

but I can't quite figure out where...

Drawing1.dwg

Edited August 20, 2023 by aridzv

[BIGAL]

Did you post this question some where else I seem to remember it. A simple answer is yes get all blocks as a list, of name and entity name, sort on name, then go through the list comparing pairs if same then add to a  new list is (Bname entity 1) once the bname changes the list becomes (bname entity 2) and so on.

 

The location of the text is a bit tricky I would start with a bounding box and find mid pt. Using an attribute would be better.

Edited August 19, 2023 by BIGAL

[aridzv]

@BIGAL

Yes,

I initially post it as topic and then referred it here.

About your explanations -

Way above my coding skills...

 

Thanks, 

aridzv.

Edited August 20, 2023 by aridzv

[BIGAL]

Try this

(defun c:wow ( / ss ent bname lst lst2 x y val val2 pointmin pointmax bobj mp)
(setvar 'textstyle "standard")
(prompt "select blocks")
(setq ss (ssget '((0 . "INSERT"))))

(if (= ss nil)
(alert "No blocks selected ")
(progn
(setq lst '())
(repeat (setq x (sslength ss))
 (setq ent (entget (ssname ss (setq x (1- x)))))
  (setq bname (cdr (assoc 2 ent)))
 (setq ent (cdr (assoc -1 ent)))
 (setq lst (cons (list bname ent) lst))
)
(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))
                                             
(setq lst2 '())
(setq x 0 y 1)
(repeat (length lst)
(if (= (car (nth x lst)) (car (nth (1+ x) lst)))
  (setq lst2 (cons (list (car (nth x lst)) (cadr (nth x lst)) y) lst2))
  (progn 
  (setq lst2 (cons (list (car (nth x lst))(cadr (nth x lst)) y) lst2))
  (setq y (1+ y))
  )
)
(setq x (1+ x))
)
  
(foreach blk lst2
  (setq ent (cadr blk))
  (setq bobj (vlax-ename->vla-object ent))
  (vla-GetBoundingBox bobj 'minpoint 'maxpoint)
  (setq pointmin (vlax-safearray->list minpoint))
  (setq pointmax (vlax-safearray->list maxpoint))
  (setq mp (mapcar '* (mapcar '+ pointmin pointmax) '(0.5 0.5)))
  (command "text" mp 1.0 0.0 (nth 2 blk))
)
                                             
)
)
(princ)
)
(c:wow)

 

[maahee]

(setq prompt "\nEnter shape ([R]ight Bottom, [L]eft Bottom, [C]enter, [A]lternater ")

 

 (setq option (getstring prompt options '("R" "L" "C" "A")))

  (cond

    ((= (strcase option ) "R")

      (setq vertpoint-c (polar vertpoint (+ (angle nextpoint vertpoint) pi ) (/ vd 2)))

      (setq curpoint-c (polar curpoint (angle nextpoint vertpoint) (/ vd 2)))

      (setq c1 (polar curpoint-c (+ (angle curpoint vertpoint) (* pi 1.5)) vm))

      (setq v1 (polar vertpoint-c (+ (angle curpoint vertpoint) (* pi 0.5)) vm))

      (command "line" curpoint-c c1 vertpoint-c v1 "c""")

    )

 

   ((= (strcase option) "L")

 (setq curpoint-1-c (polar curpoint-1 (+ (angle curpoint curpoint-1) pi ) (/ vd 2.0)))

(setq nextpoint-c (polar nextpoint (angle curpoint curpoint-1) (/ vd 2.0)))

(setq c2 (polar curpoint-1-c (+ (angle curpoint-1 nextpoint) (* pi 0.5)) vm))

(setq n2 (polar nextpoint-c (+ (angle curpoint-1 nextpoint) (* pi 1.5)) vm))

(command "line" curpoint-1-c c2 nextpoint-c n2 "c"""))

 )

 

 ((= (strcase option) "C")

 (setq next-mb (polar nextpoint-f (angle nextpoint-f nextpoint-b) (/ (distance nextpoint-f nextpoint-b) 2.0)))

(setq next-mbc (polar next-mb (+ (angle nextpoint-f nextpoint-b) (/ pi 2)) (/ vd 2.0)))

(setq c3 (polar curpoint-1-c (+ (angle curpoint-1-c next-mbc) (* pi 0.5)) vm)) ;;;; curpoint-1-c extract from option 2

(setq v3 (polar next-mbc (+ (angle curpoint-1-c next-mbc) (* pi 1.5)) vm))

(command "line" curpoint-1-c c3 next-mbc v3 "c""")

(setq c4 (polar next-mbc (+ (angle vertpoint-c next-mbc) (* pi 0.5)) vm))

(setq n4 (polar vertpoint-c (+ (angle vertpoint-c next-mbc) (* pi 1.5)) vm)) ;;;; vertpoint-c extract from option 1

(command "line" vertpoint-c c4 next-mbc n4 "c""")

    )

(t (princ "\nInvalid shape. Please enter R (Right Bottom), L (Left Bottom), A (Alternative) or C

(Center).\n"))

  )

 

This option selection not work I need help to solve it if options is not selected then code run without above option 

Edited August 21, 2023 by maahee

[Steven P]

7 minutes ago, maahee said:

This option selection not work I need help to solve it

 

Option selection is this part? 

 (setq option (getstring prompt options '("R" "L" "C" "A")))

 

The getstring function is the wrong format, it should be (getstring [cr] [msg])

Where [cr] is T or nothing to allow the user to enter spaces (in the case of T) or if a space acts like a carriage return

[msg] would be prompt in your example

(https://help.autodesk.com/view/ACD/2015/ENU/?guid=GUID-B139EFBD-74B7-4276-B422-D2186F7D8D0A)

 

If you want to use options look at initget as a line immediately before the getstring line - which should be replaced by getkword (http://docs.autodesk.com/ACD/2013/ENU/index.html?url=files/GUID-9ED8841B-5C1D-4B3F-9F3B-84A4408A6BBF.htm,topicNumber=d30e618800)

 

(initget "R L C A")
(getkword (strcat prompt))

 

 

and this from Lee Mac will test that you have selected a valid input:

 

;;https://www.cadtutor.net/forum/topic/6451-initget-amp-getkword/

(and (not (initget 1 "R L C A")) (setq option (getkword prompt)))

 

 

[aridzv]

On 8/20/2023 at 11:06 AM, BIGAL said:

Try this

(defun c:wow ( / ss ent bname lst lst2 x y val val2 pointmin pointmax bobj mp)
(setvar 'textstyle "standard")
(prompt "select blocks")
(setq ss (ssget '((0 . "INSERT"))))

(if (= ss nil)
(alert "No blocks selected ")
(progn
(setq lst '())
(repeat (setq x (sslength ss))
 (setq ent (entget (ssname ss (setq x (1- x)))))
  (setq bname (cdr (assoc 2 ent)))
 (setq ent (cdr (assoc -1 ent)))
 (setq lst (cons (list bname ent) lst))
)
(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))
                                             
(setq lst2 '())
(setq x 0 y 1)
(repeat (length lst)
(if (= (car (nth x lst)) (car (nth (1+ x) lst)))
  (setq lst2 (cons (list (car (nth x lst)) (cadr (nth x lst)) y) lst2))
  (progn 
  (setq lst2 (cons (list (car (nth x lst))(cadr (nth x lst)) y) lst2))
  (setq y (1+ y))
  )
)
(setq x (1+ x))
)
  
(foreach blk lst2
  (setq ent (cadr blk))
  (setq bobj (vlax-ename->vla-object ent))
  (vla-GetBoundingBox bobj 'minpoint 'maxpoint)
  (setq pointmin (vlax-safearray->list minpoint))
  (setq pointmax (vlax-safearray->list maxpoint))
  (setq mp (mapcar '* (mapcar '+ pointmin pointmax) '(0.5 0.5)))
  (command "text" mp 1.0 0.0 (nth 2 blk))
)
                                             
)
)
(princ)
)
(c:wow)

 

Hi @BIGAL and thanks for the reply.

I see that the numbers are entered as text.

is it possible to enter them in to the ORDER tag attribute of the blocks?

aridzv.

 

Edited August 21, 2023 by aridzv

[Steven P]

17 hours ago, aridzv said:

Hi @BIGAL and thanks for the reply.

Unfortunately the lisp did not work...

No values were entered to the "ORDER" tag attribute...

aridzv.

 

 

BigAls code is working well, just needs to add the value to the tag 'Order' in the last loop instead of writing it as text.

 

He'll be along later no doubt with some inspired piece of code, probably a line to add that will do that.

 

For now have a look at this and see if you can fit it in, untested but might just work

 

;;Add this line at the end of BighAls 'foreach' section, above the line (commansd "Text"....)
(LM:vl-setattributevalue blk "Order" (nth 2 blk) )



;;copy this function into yuour LISP file somewhere
;;http://www.lee-mac.com/attributefunctions.html
(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)

 

Edited August 22, 2023 by Steven P

[aridzv]

Hi @Steven P and thanks for the reply.

I'm getting this error:

; ----- Error around expression -----
; (BLK "ORDER" (VLE-NTH2 BLK))
; in file : 
; C:\Temp\wow.lsp

 

thanks,

aridzv