Jump to content

Lisp to increment letters with prefix or suffix


asdfgh

Recommended Posts

Hello everyone,

 

Is there any lisp routine to increment letters in X or Y direction with prefix and suffix definition (as TCOUNT in autocad but for letters)

So for example, i have a block here with attribute, the attribute values here are 1-BB for example, so i want to select all the blocks i need to change, asssign the prefix (which will not be changed) as (1-B), define that the increment direction is Y direction here, so the result would be (1-BB , 1-BC , 1-BD). Attached photos and DWG are availbale for your reference.

 

Thanks in advance.

image.png.8ee026e8274da641fabb436ee91a4c67.pngimage.png.b60a72fea48d5e2f553f53b1a48b2b68.pngnew block.dwg

Link to comment
Share on other sites

Leemac lisp is good but with blocks its works by inserting new block and each new block you insert will be incremented.

I don't want that i want he blocks already existed to be incremented

Link to comment
Share on other sites

I think he had another which I didn't like - I can't remember it's name but that numbers things top left to bottom right or something using what is already in the drawing, you are right, incarray which I do like a lot creates new entities. The second one I don't like works brilliantly but I prefer a little more say in what number each is, but have a look for that it might do what you are wanting

 

What I do now is insert everything I need, with the lowest value text set as it needs to be, my LISP lets you select that and each subsequent text that you select will be an increment of that. Works but like a lot of these is in a state of being made better. I don't have one that will let you select all the entities in one go though.

 

Have a look at Lee Macs see if you can find the other one and see if it works for you (far better than what I write), and if not I can dig out the parts of mine tomorrow sometime (Sunday here CAD is off so I can't check I have copied everything you need you see)

Link to comment
Share on other sites

ok no problem. actually these are blocks to number axes, so each axe has a different letter or number. But part of the text remain constant and part of the text change. for example here the part "1-B" will remain constant and other parts will be the part incremented so the result would be "1-bb" "1-bc" "1-bd" and so on. so i need a lisp that makes me define a fixed part and define the part to be changed part and how the increment would be as in this case as the texts are below each other so y direction in the direction of increment. but may be if the blocks were beside each other the increment would be horizontally in x direction.

 

I hope that would be clear if you have any questions i am open to answer

 

Thank you for your reply

Link to comment
Share on other sites

There is nice functions by Gile that increments, say the BA BB BC etc. so could read an existing string and get a start number. Then say a pick pick pick sequence.

 

; Alpha2Number - Converts Alpha string into Number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Str$ = String to convert
; Syntax example: (Alpha2Number "ABC") = 731
;-------------------------------------------------------------------------------
(defun Alpha2Number (Str$ / Num#)
  (if (= 0 (setq Num# (strlen Str$)))
    0
    (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
       (Alpha2Number (substr Str$ 2))
    )
  )
)
;-------------------------------------------------------------------------------
; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"
;-------------------------------------------------------------------------------
(defun Number2Alpha (Num# / Val#)
  (if (< Num# 27)
    (chr (+ 64 Num#))
    (if (= 0 (setq Val# (rem Num# 26)))
      (strcat (Number2Alpha (1- (/ Num# 26))) "Z")
      (strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#)))
    )
  )
);defun Number2Alpha

 

 

 

  • Like 1
Link to comment
Share on other sites

Here is what I use, 'CTX+' - inspired by what Lee Mac did with CTX though not as neat or as tidy.

 

Set one text as you want it to be (for example '1-BB', can be text, mtext, attribute, or dimension) and this will increment the last digit by 1 in the next text you select, and again to the next one until you cancel. This works by selecting each text in turn (see above why).

 

 

(defun c:ctx+ ( / increment sel endloop ent entlst base)
  (if (= increments nil) (setq increments 1))
  (setq endloop "No")
  (setq sel "1")
  (while (= endloop "No")
    (initget "4 3 2 1 0 -1 -2 -3 -4 Exit")
    (setq sel (nentsel (strcat "\nSelect Text or Enter Text Increment (" (itoa increments) ") [3/2/1/0/-1/-2/-3/Exit]: ") ) )
    (cond
;;      (  (null sel)(princ "\nMissed! Select text, enter increment or press <escape> or 'E'\n") )
      (  (null sel)(setq endloop "Yes") )
      (  (= "Exit" sel)(princ)(exit) )
      (  (= "-3" sel)(setq increments (atoi sel)) )
      (  (= "-4" sel)(setq increments (atoi sel)) )
      (  (= "-2" sel)(setq increments (atoi sel)) )
      (  (= "-1" sel)(setq increments (atoi sel)) )
      (  (= "0" sel) (setq increments (atoi sel)) )
      (  (= "1" sel) (setq increments (atoi sel)) )
      (  (= "2" sel) (setq increments (atoi sel)) )
      (  (= "3" sel) (setq increments (atoi sel)) )
      (  (= "4" sel) (setq increments (atoi sel)) )
      (  (if (and (cdr (assoc 1 (entget (car sel))))(wcmatch (cdr (assoc 0 (entget (car sel)))) "TEXT,MTEXT,ATTRIB") ) (setq endloop "Yes")) )
      (  (if (not (wcmatch (cdr (assoc 0 (entget (car sel)))) "TEXT,MTEXT,ATTRIB") ) (princ "\nThats not text...\n")) )
    )
  ) ;;end while
  (setq endloop "No")

    (setq ent (car sel))
    (setq entlst (entget ent))
    (setq base (cdr (assoc 1 entlst)))
    (if (= increment nil) (setq increment increments))

  (while
    (while (= endloop "No")
      (setq sel (nentsel "\nSelect Text to Replace and Increment: ") )
      (cond
        (  (null sel)(setq endloop "Yes") )
;;        (  (null sel)(princ "\nMissed! Select text, enter increment or press <escape> or 'E'\n") )
        (  (= "Exit" sel)(princ)(exit) )
        (  (if (and (cdr (assoc 1 (entget (car sel))))(wcmatch (cdr (assoc 0 (entget (car sel)))) "TEXT,MTEXT,ATTRIB") ) (setq endloop "Yes")) )
        (  (if (not (wcmatch (cdr (assoc 0 (entget (car sel)))) "TEXT,MTEXT,ATTRIB") ) (princ "\nThats not text...\n")) )
      )
    ) ;;end while
    (uprev base sel increment)
    (setq endloop "No")
    (setq increment (+ increment increments))
  );;end while
)



(defun uprev (base sel increments / ent entlist currentrevision revlength revisionprefix anumber ones tens hundreds thousands leadingzero dday mmonth yyear yyyear daysinmonth monthlength revcode revletter increaseby sel endloop)
  (setq ent (car sel))
  (setq entlst (entget ent))
  (setq currentrevision (cdr (assoc 1 entlst)))
  (setq currentrevision base)
  (setq revlength (strlen currentrevision)) ;;length of selected revision
  (setq revisionprefix "")
  (setq anumber 0)

;;date processing
  (setq dday "")
  (if (and (or (= revlength 8)(= revlength 10))(or (if = (wcmatch currentrevision "??/??/*") t)(if = (wcmatch currentrevision "??.??.*") t)))
    (progn
      (setq dday (atoi (substr currentrevision 1 2)))
      (setq mmonth (atoi (substr currentrevision 4 2))) ;; as integer
      (setq yyear (atoi (substr currentrevision (- revlength 1) 2))) ;; last 2 digits as integer.
      (setq ddaysinmonth (list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 1))
      (setq daysinmonth (list 31 28 31 30 31 30 31 31 30 31 30 31))
      (setq monthsinyear (list 1 2 3 4 5 6 7 8 9 10 11 12 1))
      (setq yyyear (atoi (substr currentrevision 7 2)))

      (if (= revlength 10)(setq yyyear (itoa yyyear)))(if (= revlength 8)(setq yyyear "")) ;; works out for 'nnxx' in date

      (setq monthlength (nth (- mmonth 1) daysinmonth)) ;;days in the month
      (if (and (= mmonth 2)(= (float (/ yyear 0.4)) (* (fix (/ yyear 4)) 10) ) )(setq monthlength 29)) ;; corrects for leap year
      (setq ddaysinmonth (subst 1 (+ monthlength 1) ddaysinmonth) ) ;; days in the month

      (setq acount increments)
      (while (< 0 acount) ;;if increase rev
        (setq dday (nth dday ddaysinmonth)) ;;increase day by 1
        (if (= dday 1) (setq mmonth (nth mmonth monthsinyear)) ) ;;if day went to 1st, increase month
        (if (and (= dday 1)(= mmonth 1)) (setq yyear (+ yyear 1)) )
        (if (= 100 yyear)(if (/= "" yyyear)(setq yyyear (itoa (+ 1 (atoi yyyear))))))
        (if (= 100 yyear)(setq yyear 00))
        (setq acount (- acount 1))
      ) ;end while

      (setq acount increments)
      (while (> 0 acount) ;;if decrease rev
        (setq dday (- dday 1)) ;;decrease day by 1
        (if (= 0 dday)
          (progn
            (setq mmonth (- mmonth 1))
            (if (= mmonth 0)
              (progn
                (if (= yyear 0)
                  (progn
                    (setq yyear 100)
                    (if (/= "" yyyear) (setq yyyear (itoa (- (atoi yyyear) 1))))
                  )
                )
                (setq yyear (- yyear 1))
                (setq mmonth 12)
              )
            )
            (setq dday (nth (- mmonth 1) daysinmonth))
          )
        )
        (setq acount (+ acount 1))
      ) ;end while

      (if (> 10 yyear)
        (progn
          (if (/= "" yyyear) (setq yyyear (itoa (* 10 (atoi yyyear))) ))
          (if (= "" yyyear) (setq yyyear "0"))
        )
      )

      (setq breaker "/")
      (if (= (vl-string-search "." currentrevision) 2) (setq breaker "." ) )
      (setq revletter (strcat (cond ((< dday 10) "0")(t "")) (itoa dday) breaker (cond ((< mmonth 10) "0")(t "")) (itoa mmonth) breaker yyyear (itoa yyear)       ))
    )
  )
;;;end of date processing

;;number processing
  (if (= dday "")(progn
    (if (< 0 revlength)(progn
      (setq ones (substr currentrevision revlength))
      (if (numberp (read ones))(setq anumber 1))
    ))
    (if (< 1 revlength)(progn
      (setq tens (substr (substr currentrevision (- revlength 1) 2 ) 1 1))
      (if (and (= 1 anumber) (numberp (read tens))) (setq anumber 2))
    ))
    (if (< 2 revlength)(progn
      (setq hundreds (substr (substr currentrevision (- revlength 2) 2 ) 1 1))
      (if (and (= 2 anumber) (numberp (read hundreds))) (setq anumber 3))
    ))
    (if (< 3 revlength)(progn
      (setq thousands (substr (substr currentrevision (- revlength 3) 3 ) 1 1))
      (if (and (= 3 anumber) (numberp (read thousands))) (setq anumber 4))
    ))

;;work out numerical revision.
    (if (> anumber 0)
      (progn
        (setq revnumber (substr currentrevision (- revlength (- anumber 1)) anumber))
        (setq revnumber (itoa (+ increments (read revnumber)))) ;;increase rev number by 1
        (if (and (> revlength anumber)(/= revlength anumber))
          (setq revisionprefix (substr currentrevision 1 (- revlength anumber))) ;;first characters of revision
        ) ;end if

        ;;fix leading zeros
        (setq leadingzeros (- anumber (strlen revnumber)))
        (if (= 3 leadingzeros)(setq leadingzero "000"))
        (if (= 2 leadingzeros)(setq leadingzero "00"))
        (if (= 1 leadingzeros)(setq leadingzero "0"))
        (if (> 1 leadingzeros)(setq leadingzero ""))

        (setq revletter (strcat revisionprefix leadingzero revnumber))
      ) ; end progn
    ) ; end if

;;Work out letters revisions
    (if (= anumber 0)
      (progn
        (setq revcode (+ increments (ascii ones))) ;;increase rev letter by 1

        ;;set exceptions here
        (if (= 73 revcode)(setq revcode 74)) ;;I
        (if (= 79 revcode)(setq revcode 80)) ;;O
        (if (= 105 revcode)(setq revcode 106)) ;;i
        (if (= 111 revcode)(setq revcode 112)) ;;o.. its of to work we go.
        (if (= 91 revcode)(setq revcode 65)) ;;Z -> A. Won't increment 'tens' value
        (if (= 123 revcode)(setq revcode 97)) ;;z -> a Won't increment 'tens' value
        (setq revisionprefix (substr currentrevision 1 (- revlength 1))) ;;first characters of revision
        (setq revletter (strcat revisionprefix (chr revcode)))
      ) ; end progn
    ) ; end if
  ));; end of number processing

  (setq entlst (subst (cons 1 revletter) (assoc 1 entlst) entlst))
  (entmod entlst)
  (entupd ent)
  (command "regen") ;;in case of nested blocks
  (princ)
)

 

Link to comment
Share on other sites

Give this a try and let me know if it is the one you are after.

(defun c:Test (/ int sel ent get lst fun str tmp ltr 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 (getstring "\nSpecify prefix with letter at the end : "))
       (or (or (<= 65 (ascii (setq ltr (strcase (substr pre (strlen pre))))) 90)
               (= "" pre)  
               )
           (alert "Prefix must end with letter <!>")
           )
       (princ "\nSelect Attributed blocks < tert > : ") 
       (setq str pre int -1 sel (ssget "_:L" '((0 . "INSERT") (2 . "tert") (66 . 1))))
       (while (setq int (1+ int)
                    ent (ssname sel int))
         (setq get (entget ent)
               lst (cons (list (cdr (assoc 10 get)) ent) lst)
               )
         )
       (setq fun (if (= key "X") car cadr))
       (mapcar (function (lambda (obj)
                           (setq pre str obj (cadr obj))
                           (while (/= (cdr (assoc 0 (setq get (entget (setq obj (entnext obj)))))) "SEQEND")
                             (entmod (subst (cons 1 (setq pre (strcat pre ltr))) (assoc 1 get) get))
                             )
                           (if (<= 65 (setq tmp (1+ (ascii ltr))) 90) (setq ltr (chr tmp))
                             (setq str (strcat str "Z") ltr "A")
                             )
                           )
                         )
               (vl-sort lst (function (lambda (j k) (< (fun (car j)) (fun (car k)))))))
       )
  (princ)
  ) (vl-load-com)
                  

 

  • Thanks 1
Link to comment
Share on other sites

Just looking at this Tharwat, it might be better with a 'start number / letter' option as well as the prefix option, when I tried it just now it adds and increments the last character in the prefix,

 

For example

'1-B'   -> '1-BB', '1-BC'. '1-BD'.....

'1-Q'  -> '1-QQ'. '1-QR', '1-QS'.....

Link to comment
Share on other sites

Like Steven a more global solution using the Gile code you can start with any combination you like 1-B, 1-BB, 1-BBB and so on would pick say the "1-B" pull the "B" suffix and get a number using Alpha2Number then add 1 use strcat "1-" and Number2Alpha so next is 1-C, next 1-D up to 1-Z, then it becomes 1-AA, 1-AB. Picking start text makes it easier to set just that.

 

Need asdfgh want an auto answer or a pick, pick, pick answer. 2nd question is it always a block attribute or mtext or text, may need to do for all 3.

 

 

 

  • Like 1
Link to comment
Share on other sites

20 hours ago, Tharwat said:

Give this a try and let me know if it is the one you are after.

(defun c:Test (/ int sel ent get lst fun str tmp ltr 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 (getstring "\nSpecify prefix with letter at the end : "))
       (or (or (<= 65 (ascii (setq ltr (strcase (substr pre (strlen pre))))) 90)
               (= "" pre)  
               )
           (alert "Prefix must end with letter <!>")
           )
       (princ "\nSelect Attributed blocks < tert > : ") 
       (setq str pre int -1 sel (ssget "_:L" '((0 . "INSERT") (2 . "tert") (66 . 1))))
       (while (setq int (1+ int)
                    ent (ssname sel int))
         (setq get (entget ent)
               lst (cons (list (cdr (assoc 10 get)) ent) lst)
               )
         )
       (setq fun (if (= key "X") car cadr))
       (mapcar (function (lambda (obj)
                           (setq pre str obj (cadr obj))
                           (while (/= (cdr (assoc 0 (setq get (entget (setq obj (entnext obj)))))) "SEQEND")
                             (entmod (subst (cons 1 (setq pre (strcat pre ltr))) (assoc 1 get) get))
                             )
                           (if (<= 65 (setq tmp (1+ (ascii ltr))) 90) (setq ltr (chr tmp))
                             (setq str (strcat str "Z") ltr "A")
                             )
                           )
                         )
               (vl-sort lst (function (lambda (j k) (< (fun (car j)) (fun (car k)))))))
       )
  (princ)
  ) (vl-load-com)
                  

 

it works brilliantly, i just want that in y direction the numbering would increase from top to bottom not from bottom to top, otherwise it is great

Link to comment
Share on other sites

4 minutes ago, asdfgh said:

it works brilliantly, i just want that in y direction the numbering would increase from top to bottom not from bottom to top, otherwise it is great

Yup you are right, here is the revised one to increment down on Y direction.

(defun c:Test (/ int sel ent get lst fun str tmp ltr pre key opr)
  ;;----------------------------------------------------;;
  ;;	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 (getstring "\nSpecify prefix with letter at the end : "))
       (or (or (<= 65 (ascii (setq ltr (strcase (substr pre (strlen pre))))) 90)
               (= "" pre)  
               )
           (alert "Prefix must end with letter <!>")
           )
       (princ "\nSelect Attributed blocks < tert > : ") 
       (setq str pre int -1 sel (ssget "_:L" '((0 . "INSERT") (2 . "tert") (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 pre str obj (cadr obj))
                           (while (/= (cdr (assoc 0 (setq get (entget (setq obj (entnext obj)))))) "SEQEND")
                             (entmod (subst (cons 1 (setq pre (strcat pre ltr))) (assoc 1 get) get))
                             )
                           (if (<= 65 (setq tmp (1+ (ascii ltr))) 90) (setq ltr (chr tmp))
                             (setq str (strcat str "Z") ltr "A")
                             )
                           )
                         )
               (vl-sort lst (function (lambda (j k) (opr (fun (car j)) (fun (car k)))))))
       )
  (princ)
  ) (vl-load-com)

 

  • Like 1
  • Thanks 1
Link to comment
Share on other sites

3 hours ago, Tharwat said:

Yup you are right, here is the revised one to increment down on Y direction.

(defun c:Test (/ int sel ent get lst fun str tmp ltr pre key opr)
  ;;----------------------------------------------------;;
  ;;	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 (getstring "\nSpecify prefix with letter at the end : "))
       (or (or (<= 65 (ascii (setq ltr (strcase (substr pre (strlen pre))))) 90)
               (= "" pre)  
               )
           (alert "Prefix must end with letter <!>")
           )
       (princ "\nSelect Attributed blocks < tert > : ") 
       (setq str pre int -1 sel (ssget "_:L" '((0 . "INSERT") (2 . "tert") (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 pre str obj (cadr obj))
                           (while (/= (cdr (assoc 0 (setq get (entget (setq obj (entnext obj)))))) "SEQEND")
                             (entmod (subst (cons 1 (setq pre (strcat pre ltr))) (assoc 1 get) get))
                             )
                           (if (<= 65 (setq tmp (1+ (ascii ltr))) 90) (setq ltr (chr tmp))
                             (setq str (strcat str "Z") ltr "A")
                             )
                           )
                         )
               (vl-sort lst (function (lambda (j k) (opr (fun (car j)) (fun (car k)))))))
       )
  (princ)
  ) (vl-load-com)

 

This is awesome, thank you so much

  • Like 1
Link to comment
Share on other sites

Hi @Tharwat.

First let me write that this is brilliant code 👏!

I'm trying to revise it a little to do this:

1. select all blocks in the selection set. for that I've removed the (2 . "tert") from the code and it is working - no problem there.

2. in all the blocks that where selected, I need to select for increment only the attributes that their tag name is "ORDER". I think that I need to use DXF group "Attrib" with code 2, But I can't quite figure out how to write another nested "if" condition to include this in the lisp to sort only those attributes. this can be hard coded - No need to let the user define (or type...) the tag name.

3. last - I will need to change the increment from letters to numbers, but I will try to deal with it later myself and only if I'll fail I will come back here to ask for more help....

 

If you could help me with section 2 that will be a great help!!

regards,

aridzv.

 

Edited by aridzv
Link to comment
Share on other sites

25 minutes ago, aridzv said:

Hi @Tharwat.

First let me write that this is brilliant code 👏!

 

2. in all the blocks that where selected, I need to select for increment only the attributes that their tag name is "ORDER". I think that I need to use DXF group "Attrib" with code 2, But 

 

If you could help me with section 2 that will be a great help!!

 

Thank you. :)

 

Its easy to check for tag name then set the desire value in attribute as follows:

(if (= (cdr (assoc 2 get)) "ORDER") ;; add this part 
  (entmod (subst (cons 1 (setq pre (strcat pre ltr))) (assoc 1 get) get)) 
  ) ;; and the ending bracket

 

  • Thanks 1
Link to comment
Share on other sites

@Tharwat

thanks for the help - I entered your additional code and it worked!...

The next step I tried was to replace the letter increment with a numeric increment.

I've replaced the original "getstring" with "getint" to store the starting value for the increment process as an integer into the variable "pre" which according to my understanding contains the value to be inserted in to the attribute.

then,in the second "While" loop, where I entered your additional code I tried to use it - and I fialed...

the error I'm getting is:

; ----- Error around expression -----
; (ENTGET ENT)  

 

And this is the code I'm trying to run:

(defun c:Testincrmnt3 (/ int sel ent get lst fun str tmp ltr 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 "Enter The Numbering Starting Value:"))
       ;(or (or (<= 65 (ascii (setq ltr (strcase (substr pre (strlen pre))))) 90)
               ;(= "" pre)  
               ;)
           ;(alert "Prefix must end with letter <!>")
           ;)
       ;(princ "\nSelect Attributed blocks < tert > : ") 
       (setq str pre 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)
               )
         )
       (setq fun (if (= key "X") car cadr))
       (mapcar (function (lambda (obj)
                           (setq pre str obj (cadr obj))
                           (while (/= (cdr (assoc 0 (setq get (entget (setq obj (entnext obj)))))) "SEQEND")
                            (if (= (cdr (assoc 2 get)) "ORDER")
                               (entmod (subst (cons 1 (setq pre (+ 1 pre))) (assoc 1 get) get))
                               )
                            )
                           ;(if (<= 65 (setq tmp (1+ (ascii ltr))) 90) (setq ltr (chr tmp))
                             ;(setq str (strcat str "Z") ltr "A")
                              ;(setq str (rtos (+ 1 tmp) 2 0))
                             ;)
                           )
                         )
               (vl-sort lst (function (lambda (j k) (< (fun (car j)) (fun (car k)))))))
       )
  (princ)
  ) (vl-load-com)
                  

 

What am I doing wrong there?...

 

regards,

aridzv.

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.

×
×
  • Create New...