number in sequence and insert block at same time

[MCarmoGomes]

Hi

I found a routine allows to copy a numerical text string multiple times, incrementing the number by one each time.

 

Now, i need to insert one block at the same time as the text in sequence.

 

Can someone help me?

 

 

 

This is the routine that i found:

 

;======================================================================

; CopyInc2.lsp Last Revision: C.French 29/09/99

;----------------------------------------------------------------------

; This routine allows you to copy a numerical text string multiple

; times, incrementing the number by one each time. If the text has

; an alphabetic prefix, this will be copied too. For example if you

; copy the piece of text "A102", the next ones will be "A103", "A104"

; and so on.

;

; Many thanks to J. Richardson for the original "CopyInc" routine

; upon which this one is based.

;======================================================================

(defun C:CopyInc ( / OrigEnt OrigEntData OrigText NumText

PrefixLen Prefix Num NewEntData NewPt Continue)

(setq CopyIncOldErrorFunc *error*)

(setq *error* CopyIncErrorFunc)

(while (= OrigEnt nil)

(setq OrigEnt (entsel "\nSelect text: "))

)

(setq OrigEntData (cdr (entget (car OrigEnt))))

(if (/= (cdr (assoc 0 OrigEntData)) "TEXT")

(princ "No text selected.")

(progn

(setq OrigText (cdr (assoc 1 OrigEntData)))

(setq NumText (GetSuffixDigits OrigText))

(if (= NumText "")

(princ "That text string doesn't end with a number.")

(progn

(setq PrefixLen (- (strlen OrigText)(strlen NumText)))

(if (= PrefixLen 0)

(setq Prefix "")

(setq Prefix (substr OrigText 1 PrefixLen))

)

(setq Num (atoi NumText))

(setq Continue T)

(while Continue

(setq Num (1+ Num))

(setq NewEntData (subst (cons 1 (strcat Prefix (itoa Num)))

(assoc 1 OrigEntData) OrigEntData))

(initget 128)

(setq NewPt (getpoint "\nCopy to (press Enter to quit): "))

(if (= NewPt nil)

(setq Continue nil)

(progn

(setq NewEntData (subst (cons 10 NewPt)

(assoc 10 NewEntData) NewEntData))

(entmake NewEntData)

)

)

);end of while loop

)

)

)

)

(setq *error* CopyIncOldErrorFunc)

(princ)

)

;----GetSuffixDigits---------------------------------------------------

; This function accepts a string argument which has digits at the

; end of it. It returns a string of just those digits. For example:

; (GetSuffixDigits "A102") returns "102"

; (GetSuffixDigits "102") returns "102"

; (GetSuffixDigits "") returns ""

; (GetSuffixDigits "ABC") returns ""

; (GetSuffixDigits 123) will generate an error (bad argument type)

;----------------------------------------------------------------------

(defun GetSuffixDigits ( OrigStr / Digits PrefixLen Char)

(setq Digits "")

(setq PrefixLen (strlen OrigStr))

(while (> PrefixLen 0)

(setq Char (substr OrigStr PrefixLen 1)) ;get last char of string

(if (wcmatch Char "#") ;if it's a digit...

(progn

(setq Digits (strcat Char Digits)) ;include in result str

(setq PrefixLen (1- PrefixLen)) ;ready to check next chr

)

(setq PrefixLen 0) ;quit at first alpha

)

)

(setq Digits Digits)

)

;----Error Handling----------------------------------------------------

; The routine below supplies our error handling in case the user

; cancels the CopyInc function. The global holds the pointer to the

; current error handler so it can be restored on exit.

;----------------------------------------------------------------------

(setq CopyIncOldErrorFunc nil) ;global holds old func

(defun CopyIncErrorFunc (msg)

(if (= msg "Function cancelled")

(princ " ")

(if (= msg "quit / exit abort")

(princ " ")

(princ (strcat "\nError: " msg))

)

)

(setq *error* CopyIncOldErrorFunc)

(princ)

)

;----Instructions appear after loading on how to use-------------------

(princ "\nType 'CopyInc' to copy and increment a text string.")

(princ)

[MCarmoGomes]

The lisp again (without smiles...)

 

I still waitting for help...

 

;======================================================================
;    CopyInc2.lsp                  Last Revision: C.French 29/09/99
;----------------------------------------------------------------------
;  This routine allows you to copy a numerical text string multiple
;  times, incrementing the number by one each time. If the text has
;  an alphabetic prefix, this will be copied too. For example if you
;  copy the piece of text "A102", the next ones will be "A103", "A104"
;  and so on.
;
;  Many thanks to J. Richardson for the original "CopyInc" routine
;  upon which this one is based.
;======================================================================
(defun C:CopyInc ( / OrigEnt OrigEntData OrigText NumText
                    PrefixLen Prefix Num NewEntData NewPt Continue)
 (setq CopyIncOldErrorFunc *error*)
 (setq *error* CopyIncErrorFunc)
 (while (= OrigEnt nil)
   (setq OrigEnt (entsel "\nSelect text: "))
 )
 (setq OrigEntData (cdr (entget (car OrigEnt))))
 (if (/= (cdr (assoc 0 OrigEntData)) "TEXT")
   (princ "No text selected.")
   (progn
     (setq OrigText (cdr (assoc 1 OrigEntData)))
     (setq NumText (GetSuffixDigits OrigText))
     (if (= NumText "")
       (princ "That text string doesn't end with a number.")
       (progn
         (setq PrefixLen (- (strlen OrigText)(strlen NumText)))
         (if (= PrefixLen 0)
           (setq Prefix "")
           (setq Prefix (substr OrigText 1 PrefixLen))
         )
         (setq Num (atoi NumText))
         (setq Continue T)
         (while Continue
           (setq Num (1+ Num))
           (setq NewEntData (subst (cons 1 (strcat Prefix (itoa Num)))
                                   (assoc 1 OrigEntData) OrigEntData))
           (initget 128)
           (setq NewPt (getpoint "\nCopy to (press Enter to quit): "))
           (if (= NewPt nil)
             (setq Continue nil)
             (progn
               (setq NewEntData (subst (cons 10 NewPt)
                                       (assoc 10 NewEntData) NewEntData))
               (entmake NewEntData)
             )
           )
         );end of while loop
       )
     )
   )
 )
 (setq *error* CopyIncOldErrorFunc)
 (princ)
)
;----GetSuffixDigits---------------------------------------------------
;  This function accepts a string argument which has digits at the
;  end of it. It returns a string of just those digits. For example:
;    (GetSuffixDigits "A102")  returns  "102"
;    (GetSuffixDigits "102")   returns  "102"
;    (GetSuffixDigits "")      returns  ""
;    (GetSuffixDigits "ABC")   returns  ""
;    (GetSuffixDigits 123)  will generate an error (bad argument type)
;----------------------------------------------------------------------
(defun GetSuffixDigits ( OrigStr / Digits PrefixLen Char)
 (setq Digits "")
 (setq PrefixLen (strlen OrigStr))
 (while (> PrefixLen 0)
   (setq Char (substr OrigStr PrefixLen 1))   ;get last char of string
   (if (wcmatch Char "#")                     ;if it's a digit...
     (progn
       (setq Digits (strcat Char Digits))     ;include in result str
       (setq PrefixLen (1- PrefixLen))        ;ready to check next chr
     )
     (setq PrefixLen 0)                       ;quit at first alpha
   )
 )
 (setq Digits Digits)
)
;----Error Handling----------------------------------------------------
;  The routine below supplies our error handling in case the user
;  cancels the CopyInc function. The global holds the pointer to the
;  current error handler so it can be restored on exit.
;----------------------------------------------------------------------
(setq CopyIncOldErrorFunc nil)                 ;global holds old func
(defun CopyIncErrorFunc (msg)
 (if (= msg "Function cancelled")
   (princ " ")
   (if (= msg "quit / exit abort")
     (princ " ")
     (princ (strcat "\nError: " msg))
   )
 )
 (setq *error* CopyIncOldErrorFunc)
 (princ)
)
;----Instructions appear after loading on how to use-------------------
(princ "\nType 'CopyInc' to copy and increment a text string.")
(princ)

[fixo]

This one will get you started I hope

 

(defun c:ibl (/ atd blk cnt ech ipt next next_data osm pref suff tag)
 (setq osm (getvar "osmode"))
 (setq ech (getvar "cmdecho"))
 (setq atd (getvar "attdia"))
 (setvar "osmode" 0)
 (setvar "cmdecho" 0)
 (setvar "attdia" 1)
 (setq pref (getstring T "\nSpecify prefix or press Enter for none: "))
 (setq suff (getstring T "\nSpecify suffix or press Enter for none: "))
 (setq cnt (getint "\nEnter initial number: "))
 (if cnt
 (progn
 ;(setq tag (strcase (getstring "\nEnter attribute tag for numbering: ")))
 (setq tag "NUM");change attribute tag "NUM" on tag name in your block which uses for increment numbering
 
(while (setq ipt (getpoint "\nPick insertion point of block or press Enter to Exit: "))

(command "-insert" "STA" ipt 1 1 0);<- change block name "STA" on your block name here
(setq blk (entlast))
(setq next blk)
       (while (setq next (entnext next))
(setq next_data (entget next))
(if (= tag (cdr (assoc 2 next_data)))
  (progn
    (entmod (subst (cons 1 (strcat pref (itoa cnt) suff)) (assoc 1 next_data) next_data))
    (entupd blk)
  )
)
     )
	    (setq cnt (1+ cnt))
	    )
     )
   )

 (setvar "osmode" osm)
 (setvar "attdia" atd)
 (setvar "cmdecho" ech)
 (prin1)
 )
(prompt "\ntype iBL to execute ...")
(prin1)

 

~'J'~

[MCarmoGomes]

It works very well!! Much better than i was expecting!!

thank you very much :D

[Dipali]

I Need To Do The Same Thing But Can Not Use Lisp.

Is There Any Other Way To Do This?

[fixo]

I Need To Do The Same Thing But Can Not Use Lisp.

Is There Any Other Way To Do This?

Are you talking about VBA or about about other language?

Not clearly enough what you mind...

 

~'J'~

[LCE]

Are you talking about VBA or about about other language?

Not clearly enough what you mind...

 

~'J'~

Can not be any programming as Dipali is using LT. This also excludes TCOUNT as LT does not have express tools.

 

I think you may be stuck on this 1 Dipali...

[Dipali]

Yes,

LCE is right. I can not use any customisation.

I have a block which is number(attribute) in square. I use it for parking plans. so when i insert it to show the parking spaces, I need it in increment & if i delete any parking space& hence the block, than the sequence of nos should get rearranged. It may be possible with dynamic block & script but I don't know much about them.

[MCarmoGomes]

i need more help... please

i want to have some default "prefix" because i use the same text the most of the times.

 

can someone help again? please?

[fixo]

i need more help... please

i want to have some default "prefix" because i use the same text the most of the times.

 

can someone help again? please?

 

Just change this line:

(setq pref (getstring T "\nSpecify prefix or press Enter for none: "))

 

on this one:

 

(setq pref "MyFavouritePrefix")

 

~'J'~

[MCarmoGomes]

Thanks again fixo for your quick answer.

But I want something like this:

(setq pref (getstring T "\nSpecify prefix or press Enter for "MyFavouritePrefix": "))

Can you help me again?

[fixo]

Do you mean to set a prefix by default, do you?

If so use this code block instead:

(setq pref (getstring T "\nEnter prefix or press Enter to set default <ThePrefixYouNeed> : "))
(if (eq "" pref)
   (setq pref "ThePrefixYouNeed")
 )

 

~'J'~

[MCarmoGomes]

Yes, it's what i want.

Thank you very much again

[Johnc]

Hello everyone,

I really like this lisp code and use it all the time for our ventilation parts , I just wondered if one of you clever people could help me tweak it alittle.

After selecting the Prefix I would like the code to search the drawing for all blocks called “ID” check the prefix selected “for ensample A” and find the last tag value used for example A12” and prompt the user to use the next value “A13” or enter there own number to start from

I currently have to do this manually

This is what I have so far

(if (ssget "x" '((2 . "ID")))

(progn

(setq ent (ssname (ssget "x" '((2 . "ID"))) 0))

 

(while (not (eq '"REV" (cdr (assoc 2 (setq attlst (entget ent))))))

(setq ent (entnext ent))

)

 

(if (= 1 (setq rev# (+ 1 (ascii (cdr (assoc 1 attlst))))))

(setq rev# 65)

)

My block is "ID" and theattribute tag name is "REV"

[fixo]

Hello everyone,

I really like this lisp code and use it all the time for our ventilation parts , I just wondered if one of you clever people could help me tweak it alittle.

After selecting the Prefix I would like the code to search the drawing for all blocks called “ID” check the prefix selected “for ensample A” and find the last tag value used for example A12” and prompt the user to use the next value “A13” or enter there own number to start from

I currently have to do this manually

This is what I have so far

(if (ssget "x" '((2 . "ID")))

(progn

(setq ent (ssname (ssget "x" '((2 . "ID"))) 0))

 

(while (not (eq '"REV" (cdr (assoc 2 (setq attlst (entget ent))))))

(setq ent (entnext ent))

)

 

(if (= 1 (setq rev# (+ 1 (ascii (cdr (assoc 1 attlst))))))

(setq rev# 65)

)

My block is "ID" and theattribute tag name is "REV"

 

See if this works for you

(defun getlastattrib  (blockname tagname prefix / atstr lng num osset revlist)
 (or (vl-load-com))
 (setq lng (1+ (strlen prefix))
num nil
)
 (if (setq osset (ssget "X"
   (list
     (cons 0 "INSERT")
     (cons 2 blockname)
     (cons 66 1)))
    )
   (progn
     (foreach blkobj  (mapcar 'vlax-ename->vla-object
         (vl-remove-if 'listp (mapcar 'cadr (ssnamex osset))))
(foreach att  (vlax-invoke blkobj 'getattributes)
  (if (eq (vlax-get att 'tagstring) tagname)
    (setq atstr (vlax-get att 'textstring))))
(if (wcmatch atstr (strcat prefix "*"))
  (setq revlist (cons (substr atstr lng) revlist))))

     )
   )
 (setq num (car
      (vl-sort revlist
        (function (lambda (a b) (> (atof a) (atof b)))))))
 num
 )

;Call this function inside the main programm like this:
(setq lastnum (getlastattrib "ID" "REV" "A"));<-- arguments in order: block name, tag, prefix
 (alert (vl-princ-to-string lastnum))

 

~'J'~

[Johnc]

That’s great!

Works fine

Much better than I was expecting really like the window message

Thanks again

John

[fixo]

You're welcome

Cheers

[Johnc]

Hi all,

Would it be possible to have a little help or nudge in the right direction amending this routine to search all open drawings for the prefix rather than only the current drawing?

I’ve been experimenting with the following code.

 

(defun c:sample ( / OpenDwgs eachDwg)

(setq OpenDwgs (vla-get-documents (vlax-get-acad-object)))

(vlax-for eachDwg OpenDwgs

(princ "Count")

(princ)

) ;_ end vlax-for

) ;_ end defun

 

Reading associated posts I believe this will only effectively count the open drawings not make them active for the select all.

Any help gratefully received.

Regards

John