Jump to content

Adding Prefix to ITEM_NUMBER tag only

shailujp

By shailujp
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

pBe Grand Master

pBe

Posted
Posted
When it goes to AX AY AZ...next number is AAA AAB AAC instead of BA BB BC...is this even possible?

 

Of course it is. We can do even do one better. Use one function for both Alpha and "numeric values. I wrote something similar to your request long ago, just need to find the code is all.

Link to comment
Share on other sites
  • Replies 35
  • Created
  • Last Reply

Top Posters In This Topic

  • shailujp

    16

  • Tharwat

    7

  • Lee Mac

    5

  • cwake

    5

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Tharwat Grand Master

Tharwat

Posted
Posted (edited)

I see that pBe did not post any codes in this discussion so here is my offer .

 

Note: I did my best to make the routine as best as it could be so you faced any , just let me know .

And the routine works with up to three characters only .

 

(defun c:Test (/ tag st l a b c s)
 ;;    Tharwat AL Shoufi        ;;
 ;;    Date : 24.Aug.2014        ;;
 (setq tag "X")
 (if (and (/= "" (setq st (getstring "\n Specify string :")))
          (if (vl-every '(lambda (i) (< 64 i 91))
                        (setq l (vl-string->list (strcase st)))
              )
            t
            (progn (princ "\n Alphabetical characters allowed only !")
                   nil
            )
          )
          (if (< 3 (length l))
            (progn (princ "\n Three characters allowed only !") nil)
            t
          )
     )
   (while (setq s (ssget "_+.:S:E:L" '((0 . "INSERT") (66 . 1))))
     (foreach x (vlax-invoke
                  (vlax-ename->vla-object (ssname s 0))
                  'GetAttributes
                )
       (if (eq tag (vla-get-tagstring x))
         (progn (vla-put-textstring x (apply 'strcat (mapcar 'chr l)))
                (cond ((eq (length l) 3)
                       (if (eq (caddr l) 90)
                         (progn (setq c 65)
                                (if (eq (cadr l) 90)
                                  (setq b 65)
                                )
                                (if (eq (car l) 90)
                                  (setq a 65)
                                )
                         )
                         (setq a (car l)
                               b (cadr l)
                               c (1+ (caddr l))
                         )
                       )
                       (if (vl-every '(lambda (i) (eq i 90)) l)
                         (setq l nil
                               l (list 65 65 65)
                         )
                         (setq l nil
                               l (list a b c)
                         )
                       )
                      )
                      ((eq (length l) 2)
                       (if (eq (cadr l) 90)
                         (progn (setq b 65)
                                (if (eq (car l) 90)
                                  (setq a 65)
                                  (setq a (1+ (car l)))
                                )
                                (setq l nil
                                      l (list a b)
                                )
                         )
                         (setq a (car l)
                               l (list a (1+ (cadr l)))
                         )
                       )
                      )
                      (t
                       (eq (length l) 1)
                       (if (eq (car l) 90)
                         (setq l nil
                               l (list 65 65)
                         )
                         (setq l (list (1+ (car l))))
                       )
                      )
                )
         )
       )
     )
   )
 )
 (princ)
)
(vl-load-com)

Edited by Tharwat
Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Another, assuming I have understood the requirement:

 

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] sel str tag )
   ([color=BLUE]setq[/color] tag [color=MAROON]"TAG1"[/color])
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color]
           ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]""[/color] ([color=BLUE]setq[/color] str ([color=BLUE]strcase[/color] ([color=BLUE]getstring[/color] [color=MAROON]"\nSpecify starting letter <A>: "[/color]))))
               ([color=BLUE]setq[/color] str [color=MAROON]"A"[/color])
           )
           ([color=BLUE]wcmatch[/color] str [color=MAROON]"*[~A-Z]*"[/color])
       )
       ([color=BLUE]princ[/color] [color=MAROON]"\nOnly A-Z allowed."[/color])
   )
   ([color=BLUE]while[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_+.:E:S:L"[/color] '((0 . [color=MAROON]"INSERT"[/color]) (66 . 1))))
       ([color=BLUE]or[/color] ([color=BLUE]vl-some[/color]
              '([color=BLUE]lambda[/color] ( x [color=BLUE]/[/color] a b )
                   ([color=BLUE]if[/color] ([color=BLUE]=[/color] tag ([color=BLUE]vla-get-tagstring[/color] x))
                       ([color=BLUE]progn[/color]
                           ([color=BLUE]vla-put-textstring[/color] x str)
                           ([color=BLUE]setq[/color] a   ([color=BLUE]substr[/color] str 1 ([color=BLUE]1-[/color] ([color=BLUE]strlen[/color] str)))
                                 b   ([color=BLUE]substr[/color] str ([color=BLUE]strlen[/color] str))
                                 str ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"Z"[/color] b) ([color=BLUE]strcat[/color] [color=MAROON]"A"[/color] a [color=MAROON]"A"[/color]) ([color=BLUE]strcat[/color] a ([color=BLUE]chr[/color] ([color=BLUE]1+[/color] ([color=BLUE]ascii[/color] b)))))
                           )
                       )
                   )
               )
               ([color=BLUE]vlax-invoke[/color] ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] sel 0)) 'getattributes)
           )
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nSelected block does not contain the attribute \""[/color] tag [color=MAROON]"\"."[/color]))
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted (edited)
I see that pBe did not post any codes in this discussion ....

 

Been busy and [partly lazy] :)

 

Was able to write a quick code for the OP's strange sequence. Not really sure if AAZ 's next sequence is AAAA though but anyhoo..

(defun _NumAlpha (str / _Str lcr ln)
 (if (numberp (read str))
   (itoa (1+ (atoi str)))
   (progn
     (setq fchrs (substr str 1 (1- (setq ln (strlen str)))))
     (cond
([color="blue"](eq str "") "A")[/color]
((eq (setq lcr (substr str ln)) "Z")
 (strcat (_NumAlpha fchrs) "A")
)
[color="blue"]((member lcr '("N" "H"))
 (_NumAlpha (strcat fchrs
		    (chr (1+ (ascii lcr)))
	    )
 )
)[/color]
((strcat fchrs (chr (1+ (ascii lcr)))))
     )
   )
 )
)

 

(setq letnum "A")
(repeat (* 26 2) (print (setq letnum (_NUMALPHA letnum))))
(setq letnum "1")
(repeat 12 (print (setq letnum (_NUMALPHA letnum))))

 

EDIT: LM beat me to it :D

FWIW the sub i posted should be able to handle integer value [string that is]

Edited by pBe
EDITED to skip "O" & "I"
Link to comment
Share on other sites
shailujp Collaborator

shailujp

Posted
  • Author
Posted

Hi Tharwat,

 

Your code works well upto AZ and then it continues giving me AZ AZ AZ. Doesn't go to the next number BA BB BC.

 

Lee,

Your code works well upto AZ and then it jumps to AAA AAB AAC. Doesn't go to the next number BA BB BC.

 

Just want to let you know that my requirement fulfills within 78 characters (i.e. A to Z, AA to AZ & BA to BZ). I'm not looking for more than this. I hope this helps anyway.

 

 

Was able to write a quick code for the OP's strange sequence

I'm going by the Excel sequence of columns.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted 
([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] sel str tag )
   ([color=BLUE]setq[/color] tag [color=MAROON]"TAG1"[/color])
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color]
           ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]""[/color] ([color=BLUE]setq[/color] str ([color=BLUE]strcase[/color] ([color=BLUE]getstring[/color] [color=MAROON]"\nSpecify starting letter <A>: "[/color]))))
               ([color=BLUE]setq[/color] str [color=MAROON]"A"[/color])
           )
           ([color=BLUE]wcmatch[/color] str [color=MAROON]"*[~A-Z]*"[/color])
       )
       ([color=BLUE]princ[/color] [color=MAROON]"\nOnly A-Z allowed."[/color])
   )
   ([color=BLUE]while[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_+.:E:S:L"[/color] '((0 . [color=MAROON]"INSERT"[/color]) (66 . 1))))
       ([color=BLUE]or[/color] ([color=BLUE]vl-some[/color]
              '([color=BLUE]lambda[/color] ( x )
                   ([color=BLUE]if[/color] ([color=BLUE]=[/color] tag ([color=BLUE]vla-get-tagstring[/color] x))
                       ([color=BLUE]progn[/color]
                           ([color=BLUE]vla-put-textstring[/color] x str)
                           ([color=BLUE]setq[/color] str (LM:alpha++ str))
                       )
                   )
               )
               ([color=BLUE]vlax-invoke[/color] ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] sel 0)) 'getattributes)
           )
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nSelected block does not contain the attribute \""[/color] tag [color=MAROON]"\"."[/color]))
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; Alpha++  -  Lee Mac[/color]
[color=GREEN];; Increments an uppercase alphabetical string by one, e.g. AZ => BA[/color]
[color=GREEN];; a - [str] uppercase alphabetical string[/color]

([color=BLUE]defun[/color] LM:alpha++ ( a [color=BLUE]/[/color] n )
   ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]""[/color] a)
       [color=MAROON]"A"[/color]
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"Z"[/color] ([color=BLUE]substr[/color] a ([color=BLUE]setq[/color] n ([color=BLUE]strlen[/color] a))))
           ([color=BLUE]strcat[/color] (LM:alpha++ ([color=BLUE]substr[/color] a 1 ([color=BLUE]1-[/color] n))) [color=MAROON]"A"[/color])
           ([color=BLUE]strcat[/color] ([color=BLUE]substr[/color] a 1 ([color=BLUE]1-[/color] n)) ([color=BLUE]chr[/color] ([color=BLUE]1+[/color] ([color=BLUE]ascii[/color] ([color=BLUE]substr[/color] a n)))))
       )
   )
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Alpha++ from here.

Link to comment
Share on other sites
shailujp Collaborator

shailujp

Posted
  • Author
Posted (edited)

That was quick Lee...I could not even refresh the page...and Bang..your are too fast.:D

Works wonderfully well.

 

I have another case. Just incase if you guys are interested..

 

Would it be possible to ignore alphabets O & I?

Edited by shailujp
Link to comment
Share on other sites
shailujp Collaborator

shailujp

Posted
  • Author
Posted
I have another case. Just incase if you guys are interested..

 

Would it be possible to ignore alphabets O & I?

 

I edited post #28. Not sure if you guys noticed..just reposting.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
I edited post #28. Not sure if you guys noticed..just reposting.

 

Try the following:

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] sel str tag )
   ([color=BLUE]setq[/color] tag [color=MAROON]"TAG1"[/color])
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color]
           ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]""[/color] ([color=BLUE]setq[/color] str ([color=BLUE]strcase[/color] ([color=BLUE]getstring[/color] [color=MAROON]"\nSpecify starting letter <A>: "[/color]))))
               ([color=BLUE]setq[/color] str [color=MAROON]"A"[/color])
           )
           ([color=BLUE]wcmatch[/color] str [color=MAROON]"*[~A-Z]*,*[OI]*"[/color])
       )
       ([color=BLUE]princ[/color] [color=MAROON]"\nOnly A-Z allowed, excluding I & O."[/color])
   )
   ([color=BLUE]while[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_+.:E:S:L"[/color] '((0 . [color=MAROON]"INSERT"[/color]) (66 . 1))))
       ([color=BLUE]or[/color] ([color=BLUE]vl-some[/color]
              '([color=BLUE]lambda[/color] ( x )
                   ([color=BLUE]if[/color] ([color=BLUE]=[/color] tag ([color=BLUE]vla-get-tagstring[/color] x))
                       ([color=BLUE]progn[/color]
                           ([color=BLUE]vla-put-textstring[/color] x str)
                           ([color=BLUE]setq[/color] str (LM:alpha++-mod str))
                       )
                   )
               )
               ([color=BLUE]vlax-invoke[/color] ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] sel 0)) 'getattributes)
           )
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nSelected block does not contain the attribute \""[/color] tag [color=MAROON]"\"."[/color]))
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; Alpha++  -  Lee Mac[/color]
[color=GREEN];; Increments an uppercase alphabetical string by one, e.g. AZ => BA[/color]
[color=GREEN];; a - [str] uppercase alphabetical string[/color]
[color=GREEN];; <Modified to exclude 'O' & 'I'>[/color]

([color=BLUE]defun[/color] LM:alpha++-mod ( a [color=BLUE]/[/color] c n )
   ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]""[/color] a)
       [color=MAROON]"A"[/color]
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"Z"[/color] ([color=BLUE]substr[/color] a ([color=BLUE]setq[/color] n ([color=BLUE]strlen[/color] a))))
           ([color=BLUE]strcat[/color] (LM:alpha++-mod ([color=BLUE]substr[/color] a 1 ([color=BLUE]1-[/color] n))) [color=MAROON]"A"[/color])
           ([color=BLUE]strcat[/color] ([color=BLUE]substr[/color] a 1 ([color=BLUE]1-[/color] n)) ([color=BLUE]chr[/color] ([color=BLUE]if[/color] ([color=BLUE]member[/color] ([color=BLUE]setq[/color] c ([color=BLUE]1+[/color] ([color=BLUE]ascii[/color] ([color=BLUE]substr[/color] a n)))) '(73 79)) ([color=BLUE]1+[/color] c) c)))
       )
   )
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Link to comment
Share on other sites
shailujp Collaborator

shailujp

Posted
  • Author
Posted

Hi Lee,

 

Thats awesome!!!

 

I tried every possible way and it works well.

 

I thank everyone (Tharwat, Lee & pBe) for your help and support. Great help.

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted (edited)
I thought this was the requirement Facepalm.gif

 

X2

 

@ shailujp

 

Glad you got yourself a solution. :)

 

FWIW:

A QUICK CODE UPDATE: to skip "O" & "I" AND revert back to orignal sequence "AZ" "BA" rather than "AAA"

Edited by pBe
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...