+ Reply to Thread
Page 1 of 2 1 2 LastLast
Results 1 to 10 of 13
  1. #1
    Full Member harshad's Avatar
    Computer Details
    harshad's Computer Details
    Operating System:
    XP
    CPU:
    INTEL 4
    RAM:
    1 GB
    Primary Storage:
    120 GB
    Monitor:
    SAMSUNG
    Using
    AutoCAD 2008
    Join Date
    Jul 2007
    Location
    mumbai, india
    Posts
    61

    Love lisp want for increment

    hi friends

    i want a lisp for number or alphabetical increment
    lisp ask me for dist between text and increment valu
    this is need full i add the sample this is give u idia

    thanks

    harshad
    Attached Files

  2. #2
    Forum Deity NBC's Avatar
    Using
    AutoCAD 2009
    Join Date
    Aug 2007
    Location
    Manchester, UK
    Posts
    2,109

    Default

    try using the TCOUNT function of Express Tools.

  3. #3
    Super Member ASMI's Avatar
    Using
    AutoCAD 2008
    Join Date
    Nov 2005
    Location
    Oceanus Procellarum, Moon
    Posts
    1,427

    Default

    NUM for inserting text, RENUM for changing existing text to numbers:

    Code:
    (defun c:num (/ oldPref oldSuf oldStart curStr newNum 
               actDoc actSp oldEcho oldSize *error*) 
    
      (defun *error* (msg) 
        (setvar "CMDECHO" oldEcho) 
        (princ) 
        ); end *error* 
      
      (vl-load-com) 
      (if(not num:Size)(setq num:Size(getvar "DIMTXT"))) 
      (if(not num:Pref)(setq num:Pref "")) 
      (if(not num:Suf)(setq num:Suf "")) 
      (if(not num:Num)(setq num:Num 1)) 
      (setq oldPref num:Pref 
            oldSuf num:Suf 
            oldStart num:Num 
       oldSize num:Size 
       actDoc(vla-get-ActiveDocument 
          (vlax-get-acad-object)) 
       oldEcho(getvar "CMDECHO") 
       ); end setq 
      (setvar "CMDECHO" 0) 
      (if(= (vla-get-ActiveSpace actDoc) 1) 
        (setq actSp(vla-get-ModelSpace actDoc)) 
        (setq actSp(vla-get-PaperSpace actDoc)) 
        ); end setq 
      (setq num:Size 
        (getreal 
          (strcat "\nSpecify text size <"(rtos num:Size)">: "))) 
      (if(null num:Size)(setq num:Size oldSize)) 
      (setq num:Pref 
        (getstring T 
          (strcat "\nType prefix: <"num:Pref">: "))) 
      (if(= "" num:Pref)(setq num:Pref oldPref)) 
      (if(= " " num:Pref)(setq num:Pref "")) 
      (setq num:Suf 
        (getstring T 
          (strcat "\nType suffix: <"num:Suf">: "))) 
      (if(= "" num:Suf)(setq num:Suf oldSuf)) 
      (if(= " " num:Suf)(setq num:Suf "")) 
      (setq num:Num 
        (getint 
          (strcat "\nEnter start number <"(itoa num:Num)">: "))) 
      (if(null num:Num)(setq num:Num oldStart)) 
    (while T 
      (setq curStr(strcat num:Pref(itoa num:Num)num:Suf) 
            newNum(vla-AddText actSp 
            curStr (vlax-3d-point 
           '(0.0 0.0 0.0)) num:Size)) 
      (vla-put-Alignment newNum acAlignmentMiddleCenter) 
      (command "_.copybase"(trans '(0.0 0.0 0.0)0 1)(entlast)"") 
      (command "_.erase" (entlast) "") 
      (command "_.pasteclip" pause) 
        (setq num:Num(1+ num:Num)) 
      ); end while 
      (princ) 
      ); end of c:num
    
    
    
    
    
    (defun c:renum (/ oldPref oldSuf oldStart curText curStr) 
      (vl-load-com) 
      (if(not rnm:Pref)(setq rnm:Pref "")) 
      (if(not rnm:Suf)(setq rnm:Suf "")) 
      (if(not rnm:Start)(setq rnm:Start 1)) 
      (setq oldPref rnm:Pref 
            oldSuf rnm:Suf 
            oldStart rnm:Start); end setq 
      (setq rnm:Pref 
        (getstring T 
          (strcat "\nType prefix: <"rnm:Pref">: "))) 
      (if(= "" rnm:Pref)(setq rnm:Pref oldPref)) 
      (if(= " " rnm:Pref)(setq rnm:Pref "")) 
      (setq rnm:Suf 
        (getstring T 
          (strcat "\nType suffix: <"rnm:Suf">: "))) 
      (if(= "" rnm:Suf)(setq rnm:Suf oldSuf)) 
      (if(= " " rnm:Suf)(setq rnm:Suf "")) 
      (setq rnm:Start 
        (getint 
          (strcat "\nEnter start number <" 
             (itoa rnm:Start)">: "))) 
      (if(null rnm:Start)(setq rnm:Start oldStart)) 
    (while T 
      (setq curStr(strcat rnm:Pref(itoa rnm:Start)rnm:Suf)) 
        (setq curText 
          (car 
            (nentsel "\nSelect DText/MText/Attribute or Esc to Quit "))) 
      (if 
        (and 
          curText 
          (member(cdr(assoc 0(entget curText))) '("TEXT" "MTEXT" "ATTRIB")) 
          ); end and 
        (progn 
        (vla-put-TextString 
          (vlax-ename->vla-object curText)curStr) 
        (setq rnm:Start(1+ rnm:Start)) 
        ); end progn 
        (princ "\nThis is not DText or MText! ") 
        ); end if 
      ); end while 
      (princ) 
      ); end of c:renum

  4. #4
    Super Member asos2000's Avatar
    Computer Details
    asos2000's Computer Details
    Operating System:
    WinXP
    Using
    AutoCAD 2007
    Join Date
    Sep 2007
    Location
    Cairo Egypt
    Posts
    610

    Default

    thanx ASMI
    I was searching for that lisp which renumber attribute.

    can the increment start with 01 or 001
    and what about alphabet (A, B, C, .......Y, Z, AA, AB, ....etc)
    Sorry for my English.

  5. #5
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    16,743

    Default

    I believe my AutoNum V4 lisp has this function, choose to Pick Each Insert, and then hit R.
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  6. #6
    Senior Member
    Computer Details
    VVA's Computer Details
    Operating System:
    Windows 7
    CPU:
    Intel Core i5-2400
    RAM:
    8 Gb
    Graphics:
    Nvidia Quadro 600
    Primary Storage:
    Seagate 500 GB + WD 750 GB
    Monitor:
    Philips 27"
    Using
    AutoCAD 2013
    Join Date
    Dec 2006
    Location
    Minsk, Belarus
    Posts
    427

    Default

    Quote Originally Posted by asos2000 View Post
    thanx ASMI
    I was searching for that lisp which renumber attribute.

    can the increment start with 01 or 001
    ...
    Look this thread (How about ApnumA command?)
    And more link:
    Copying a number and increase the value at the same time
    and what about alphabet (A, B, C, .......Y, Z, AA, AB, ....etc)
    I have a wonderful feature INCSUFF (Gilles Chanteau), I adapted it for the Russian alphabet. But Now I do not have time to adapt or write command: (
    Links to INCSUFF my adapted version:
    Attribute ASCII code +1
    Increment the suffix of a string
    Code:
    (defun incsuff (str inc alpha / lst crt pas ind dep quo ret)
    ;; INCSUFF -Gilles Chanteau- 2008/01/15
    ;; Adds the specified increment to a string suffix.
    ;; Is considered as suffix, all [0-9] characters from the end of the string
    ;; more [A-Z] and [a-z] characters if alpha argument is non nil.
    ;;
    ;; Adapting to the Russian alphabet VVA (Vladimir Azarko)  
    ;; Arguments
    ;; str : a string
    ;; inc : a positive integer
    ;; alpha : if non nil, [a-z] [A-Z] characters are integrated to suffix.
    ;;
    ;; Return
    ;; The string with incremented suffix (or nil if none valid suffix)
    ;;
    ;; Examples :
    ;; (incsuff "N° 002" 12 T) = "N° 014"
    ;; (incsuff "Drawing_A" 1 T) = "Drawing_B"
    ;; (incsuff "test_ZZ9" 1 T) = "test_AAA0"
    ;; (incsuff "test_ZZ9" 1 nil) = "test_ZZ10"
    ;; (incsuff "12-" 1 nil) = nil  
      
      (setq lst (reverse (vl-string->list str)))
      (while
        (and
          (setq crt (car lst))
          (cond
            ((< 47 crt 58) ;_Number
             (setq pas 10  ;_Step
                   ind 48  ;_ ASCII Code Number 0
             ) ;_ end of setq
            )
            ((and alpha (< 64 crt 91)) ;_Upper case latin
             (setq pas 26              ;_Number of letters in the alphabet (step)
                   ind 65              ;_Upper case latin A (eng)
             ) ;_ end of setq
            )
            ((and alpha (< 96 crt 123)) ;_Lower case latin
             (setq pas 26               ;_Number of letters in the alphabet (step)
                   ind 97               ;_Lower case latin A (eng)
             ) ;_ end of setq
            )
            ((and alpha (< 191 crt 224));_Upper case russian
             (setq pas 32               ;_Number of letters in the alphabet (step)
                   ind 192              ;_Upper case russian A
             ) ;_ end of setq
            )
            ((and alpha (< 223 crt 256));_Lower case russian
             (setq pas 32               ;_Number of letters in the alphabet (step)
                   ind 224              ;_Lower case russian A
             ) ;_ end of setq
            )
            ((< 0 quo)
             (setq crt (if (= 10 pas)
                         ind
                         (1- ind)
                       ) ;_ end of if
                   lst (cons (car lst) lst)
             ) ;_ end of setq
            )
          ) ;_ end of cond
        ) ;_ end of and
         (setq dep (- crt ind)
               quo (/ (+ dep inc) pas)
               ret (cons (+ ind (rem (+ dep inc) pas)) ret)
         ) ;_ end of setq
         (if (zerop quo)
           (setq ret (append (reverse (cdr lst)) ret)
                 lst nil
           ) ;_ end of setq
           (if (cdr lst)
             (setq lst (cdr lst)
                   inc quo
             ) ;_ end of setq
             (setq lst (list ind)
                   inc (if (= 10 pas)
                         quo
                         (1- quo)
                       ) ;_ end of if
             ) ;_ end of setq
           ) ;_ end of if
         ) ;_ end of if
      ) ;_ end of while
      (if ret
        (vl-list->string ret)
      ) ;_ end of if
    ) ;_ end of defun

  7. #7
    Senior Member
    Computer Details
    VVA's Computer Details
    Operating System:
    Windows 7
    CPU:
    Intel Core i5-2400
    RAM:
    8 Gb
    Graphics:
    Nvidia Quadro 600
    Primary Storage:
    Seagate 500 GB + WD 750 GB
    Monitor:
    Philips 27"
    Using
    AutoCAD 2013
    Join Date
    Dec 2006
    Location
    Minsk, Belarus
    Posts
    427

    Default

    can the increment start with 01 or 001
    Try it. Number
    Code:
    (defun c:numA (/ oldPref oldSuf oldStart curStr newNum
               actDoc actSp oldEcho oldSize *error* tmpstr)
    ;;; Numeric with alignment (add 0 before number) of number
    ;;;Edition 15.17.2009 Vladimir Azarko (VVA)
    ;;;http://www.cadtutor.net/forum/showthread.php?p=253543
      
      (defun *error* (msg)
        (setvar "CMDECHO" oldEcho)
        (princ msg)(princ)
        ); end *error*
    
      (vl-load-com)
      (if(not num:Size)(setq num:Size(getvar "DIMTXT")))
      (if(not num:Pref)(setq num:Pref ""))
      (if(not num:Suf)(setq num:Suf ""))
      (if(not num:Num)(setq num:Num 1))
      (if(not num:Alig)(setq num:Alig "1"))
      (setq oldPref num:Pref
            oldSuf num:Suf
            oldStart num:Num
       oldSize num:Size
       actDoc(vla-get-ActiveDocument
          (vlax-get-acad-object))
       oldEcho(getvar "CMDECHO")
       ); end setq
      (setvar "CMDECHO" 0)
      (if(= (vla-get-ActiveSpace actDoc) 1)
        (setq actSp(vla-get-ModelSpace actDoc))
        (setq actSp(vla-get-PaperSpace actDoc))
        ); end setq
      (setq num:Size
        (getreal
          (strcat "\nSpecify text size <"(rtos num:Size)">: ")))
      (if(null num:Size)(setq num:Size oldSize))
      (setq num:Pref
        (getstring T
          (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"num:Pref"> :")))
      (if(= "" num:Pref)(setq num:Pref oldPref))
      (if(= " " num:Pref)(setq num:Pref ""))
      (setq num:Suf
        (getstring T
          (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"num:Suf"> :")))
      (if(= "" num:Suf)(setq num:Suf oldSuf))
      (if(= " " num:Suf)(setq num:Suf ""))
    (if(not num:Alig)(setq num:Alig "1"))
    (setq  oldStart num:Alig)
    (initget "1 10 100 1000 10000 100000")
    (setq num:Alig 
        (GETKWORD 
          (strcat "\nSpecify alignment of number [1/10/100/1000/10000/100000] <"num:Alig">: ")))
      (if(null num:Alig)(setq num:Alig oldStart))
      (setq  oldStart num:Num)
      (setq num:Num
        (getint
          (strcat "\nEnter start number <"(itoa num:Num)">: ")))
      (if(null num:Num)(setq num:Num oldStart))
    (while T
      (setq oldStart (itoa num:Num))
      (while (<= (strlen oldStart)(1- (strlen num:Alig)))
        (setq oldStart (strcat "0" oldStart)))
      (setq curStr(strcat num:Pref oldStart num:Suf)
            newNum(vla-AddText actSp
            curStr (vlax-3d-point
           '(0.0 0.0 0.0)) num:Size))
      (vla-put-Alignment newNum acAlignmentMiddleCenter)
      (command "_.copybase"(trans '(0.0 0.0 0.0)0 1)(entlast)"")
      (command "_.erase" (entlast) "")
      (command "_.pasteclip" pause)
        (setq num:Num(1+ num:Num))
      ); end while
      (princ)
      ); end of c:numA
    Last edited by VVA; 15th Jul 2009 at 09:28 am. Reason: Little edit

  8. #8
    Senior Member
    Computer Details
    VVA's Computer Details
    Operating System:
    Windows 7
    CPU:
    Intel Core i5-2400
    RAM:
    8 Gb
    Graphics:
    Nvidia Quadro 600
    Primary Storage:
    Seagate 500 GB + WD 750 GB
    Monitor:
    Philips 27"
    Using
    AutoCAD 2013
    Join Date
    Dec 2006
    Location
    Minsk, Belarus
    Posts
    427

    Default

    And renumber
    Code:
    (defun c:renumA (/ oldPref oldSuf oldStart curText curStr vlaObj keepText ss)
     ;;;Routine for Renumbering
    ;;;Realization {Smirnoff} aka ASMI
    ;;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=30394Ae
    ;;;http://www.caduser.ru/cgi-bin/f1/board.cgi?t=29829Am
    ;;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=21807yD
    ;;;Edition 23.10.2006 Vladimir Azarko (VVA)
    ;;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=30394Ae
    ;;;Edition 15.17.2009 Vladimir Azarko (VVA)
    ;;;http://www.cadtutor.net/forum/showthread.php?p=253543
    (vl-load-com)
    (defun TTC_Paste(pasteStr keepText / nslLst vlaObj)
    (if (setq nslLst(nentsel "\nPaste text <exit> >>"))
    (progn
      (cond
    ((and (= 4(length nslLst))
     (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
    (setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
    (setq oldStat (vla-get-Measurement vlaObj))
    (if keepText
     (if (= (vla-get-TextOverride vlaObj) "")
     (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
     (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
    (if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
     (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
    ((and (= 4(length nslLst))
    (= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
    (setq vlaObj (vlax-ename->vla-object(car nslLst)))
    (if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
    (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
    (princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
    ((and (= 4(length nslLst))
     (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
    (princ "\nCan't paste to block's DText or MText. ")); end condition #3
    ((and (= 2(length nslLst))
    (member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
    (setq vlaObj (vlax-ename->vla-object(car nslLst)))
    (if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
    (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
    (princ "\nError. Can't pase text. "))); end condition #4
    (T (princ "\nCan't paste. Invalid object. ")); end condition #5
    ); end cond
    T); end progn
    nil); end if
    );_TTC_PASTE
    (setq aDoc(vla-get-ActiveDocument(vlax-get-acad-object)))
    (vla-StartUndoMark aDoc)
    (if(not rnm:Pref)(setq rnm:Pref ""))(if(not rnm:Suf)(setq rnm:Suf ""))
    (if(not rnm:Start)(setq rnm:Start 1))
    (if(not num:Alig)(setq num:Alig "1"))
    (setq oldPref rnm:Pref oldSuf rnm:Suf); end setq
    (setq rnm:Pref (getstring T
    		 (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <" rnm:Pref "> :")))
    (if(= "" rnm:Pref)(setq rnm:Pref oldPref))(if(= " " rnm:Pref)(setq rnm:Pref ""))
    (setq rnm:Suf (getstring T
                    (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"rnm:Suf"> :")))
    (if(= "" rnm:Suf)(setq rnm:Suf oldSuf))(if(= " " rnm:Suf)(setq rnm:Suf ""))
    (setq  oldStart num:Alig)
    (initget "1 10 100 1000 10000 100000")
    (setq num:Alig 
        (GETKWORD 
          (strcat "\nSpecify alignment of number [1/10/100/1000/10000/100000] <"num:Alig">: ")))
      (if(null num:Alig)(setq num:Alig oldStart))
    (setq  oldStart rnm:Start rnm:Start (getint (strcat "\nEnter start number <"
    (itoa rnm:Start)">: ")))
    (if(null rnm:Start)(setq rnm:Start oldStart))
    (initget "Yes No ?? ??? _Yes No Yes No")
    (setq keepText (not (= "No" (getkword "\nkeep contents of the text [Yes/No] <Yes>:"))))
    (setq rnm:Start (1- rnm:Start))
    (while
      (progn
      (setq oldStart (itoa (setq rnm:Start(1+ rnm:Start))))
      (while (<= (strlen oldStart)(1- (strlen num:Alig)))
        (setq oldStart (strcat "0" oldStart)))  
      (TTC_Paste (setq curStr(strcat rnm:Pref oldStart rnm:Suf)) keepText)))
    (vla-EndUndoMark aDoc)(princ)); end of c:renumA
    Last edited by VVA; 15th Jul 2009 at 09:29 am. Reason: New version

  9. #9
    Super Member asos2000's Avatar
    Computer Details
    asos2000's Computer Details
    Operating System:
    WinXP
    Using
    AutoCAD 2007
    Join Date
    Sep 2007
    Location
    Cairo Egypt
    Posts
    610

    Default

    Is there an English version of www.autocad.ru site
    Sorry for my English.

  10. #10
    Super Member asos2000's Avatar
    Computer Details
    asos2000's Computer Details
    Operating System:
    WinXP
    Using
    AutoCAD 2007
    Join Date
    Sep 2007
    Location
    Cairo Egypt
    Posts
    610

    Default

    Registered forum members do not see this ad.

    How can i change the default answer is No

    nkeep contents of the text [Yes/No] <Yes>
    Sorry for my English.

Similar Threads

  1. Increment value Lisp needed (with frames)
    By janisa in forum AutoLISP, Visual LISP & DCL
    Replies: 29
    Last Post: 1st Nov 2011, 12:51 pm
  2. problem, trying to running a list of lisp from within a lisp
    By twind2000 in forum AutoLISP, Visual LISP & DCL
    Replies: 4
    Last Post: 20th Aug 2007, 04:27 pm
  3. calling another lisp from within my lisp
    By thalon in forum AutoLISP, Visual LISP & DCL
    Replies: 2
    Last Post: 22nd Feb 2006, 09:56 pm
  4. Increment Number automatically
    By RCFun in forum AutoCAD General
    Replies: 1
    Last Post: 8th Aug 2003, 11:35 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts