TCOUNT LİSP BY CLİCKİNG

[egilim123]

Hi again, while i work on piping in a mechanical plumbing i need to number the pipes which already has text on all the lines , i need to seperate all the lines text by consecutive increases , for example there are 10 texts writing A,B, XY, ...etc. , i will convert them to 1,2,3,4, ... respectively by only clicking them with mouse in order, i dont think i can do it with autocad's TCOUNT command but can we modify the lisp or can anyone help to make a lisp?

[egilim123]

i need this because Autocads TCOUNT numbers them by x or y axis but in my drawings lines are not in order in x or y axis , they are in mixed places

[egilim123]

so the easiest way to select them in order is by mouse clicking i think

[Steven P]

 

Try this. copied and pasted from what I use but it might complain if I haven't copied everything you need.

 

Set the first text to the first number you want it to be, then the command ctx+, select the first text and then subsequent texts will be incrementally numbered. Should do numbers or letters but letters will only increment for the last character (A -> Z then back to A again).

 

 

 

(defun c:ctx+ ( / increment )
  (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
      )

      ;;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))
    )
  )

;;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  ;;USED FOR DRAWING REVISIONS WHERE I AND O AREN'T USED
;      (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 of number processing


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

 

[Steven P]

It is easier and quicker if say if always A -> 1, B -> 2 and so on, then can build up the LISP from a selection and change the texts all at once rather then selecting one at a time

[egilim123]

THANKS VERY MUCH @Steven P, it works for me.