Autonumbering of selected rectangles

May 24, 2013

Hi there,

I have seen a lot of autonumbering of blocks lisp examples in this forum which is a bit complicated for me.

But i just need a simple lisp that will automatically place the number in the center of the rect. after I have selected the rect. I want .

for example if i select 10 rectangle . i need the rect to be numbered 1 to 10 in sequence.

By the way can this be also applied to a hexagon?

Can anyone help?

Thanks

kenbe

May 24, 2013

Have you seen this (Incremental Numbering Suite) by Lee Mac?

http://www.lee-mac.com/numinc.html

May 24, 2013

Hi ReMark,,

I have seen the post by Lee Mac.

But that is not what I wanted..

There is no option for me to select the rectangles(not block) that is already on the drawing.

for me to label.

Thanks,

Regards

kenbe

Have you seen this (Incremental Numbering Suite) by Lee Mac?
http://www.lee-mac.com/numinc.html

Edited May 24, 2013 by KENBE
correction "not block"

May 24, 2013

Try this code may be it will helps


(defun C:INR (/ *error* cpt dxf elist en ent emake_txt inc info midpt pfx pts 
sfx sset start tht)
;; increment numbering of rectangles 

(defun *error*  (msg)
   (command "_undo" 
"_end")
         (if (and msg 
(not (wcmatch (strcase msg) 
"*BREAK*,*CANCEL*,*QUIT*,")))
     (princ (strcat 
"\nError: " msg)))


     )
 ;;helpers: 
(defun dxf (key 
alist)
 (cdr (assoc key alist))
 )

 (defun 
midpt (p1 p2)
   (mapcar '(lambda(x y)(* (+ x y) 0.5))p1 
p2)
   )



 (defun emake_txt  (pt txt hgt)

;;  middle center  ;;
 (entmake (list '(0 . 
"TEXT")
  '(100 . "AcDbEntity")
  '(67 . 
0)
  '(8 . "0")
  '(100 . 
"AcDbText")
  (cons 10(list (- (car pt) (* hgt (strlen txt) 
0.47))(- (cadr pt)(/ hgt 2.))(caddr pt)))
  (cons 40 
hgt)
  (cons 1 txt)
  '(50 . 0)
  '(41 
. 1)
  '(51 . 0)
  '(7 . "Standard"); change on your 
text style here
  '(71 . 0)
  '(72 . 
1)
  (cons 11 pt)
  '(100 . 
"AcDbText")
  '(73 . 2)))

)

;;   main part   ;;
 (if 
(and
(setq pfx   (getstring "\n Prefix: 
")
      sfx   (getstring 
"\n Suffix: ")
      start (getint 
"\n Starting number: ")
      step  
(getint "\n Increment step: ")
      tht 
(getreal "\n Text heigh: ")))

(progn
     (command "_undo" "_be")


     (prompt "\n Select rectangles in the 
right order:")
     (while
(setq sset 
(ssget "_+.:S:L"
    (list (cons 0 
"lwpolyline")
   (cons 90 
4)
   (cons 70 1))))
 (setq en (ssname sset 
0))
 (setq pts (vl-remove-if 'not (mapcar '(lambda(x)(if (= 10 (car 
x))(cdr x)))(entget en)))
  cpt (trans (midpt (car pts)(caddr 
pts)) 1 0))
  (emake_txt  cpt (strcat pfx (itoa start) sfx) 
tht)
 (setq start (+ start step))
 )

)
   )


(*error* nil)
 (princ)
) ;_ end of defun
(prompt 
"\n\t---\tType INR to execute  \t---")
(prin1)

May 25, 2013

Hi Fixo,

I get this error (Error: bad DXF group: nil) when running the program.

Did I missed out something.

Also I want to be able to do a fence selection on the rectangles not 1 by 1.

Thanks

Regards

kenbe

Try this code may be it will helps


(defun C:INR (/ *error* cpt dxf elist en ent emake_txt inc info midpt pfx pts 
sfx sset start tht)
;; increment numbering of rectangles 

(defun *error*  (msg)
   (command "_undo" 
"_end")
         (if (and msg 
(not (wcmatch (strcase msg) 
"*BREAK*,*CANCEL*,*QUIT*,")))
     (princ (strcat 
"\nError: " msg)))


     )
 ;;helpers: 
(defun dxf (key 
alist)
 (cdr (assoc key alist))
 )

 (defun 
midpt (p1 p2)
   (mapcar '(lambda(x y)(* (+ x y) 0.5))p1 
p2)
   )



 (defun emake_txt  (pt txt hgt)

;;  middle center  ;;
 (entmake (list '(0 . 
"TEXT")
  '(100 . "AcDbEntity")
  '(67 . 
0)
  '(8 . "0")
  '(100 . 
"AcDbText")
  (cons 10(list (- (car pt) (* hgt (strlen txt) 
0.47))(- (cadr pt)(/ hgt 2.))(caddr pt)))
  (cons 40 
hgt)
  (cons 1 txt)
  '(50 . 0)
  '(41 
. 1)
  '(51 . 0)
  '(7 . "Standard"); change on your 
text style here
  '(71 . 0)
  '(72 . 
1)
  (cons 11 pt)
  '(100 . 
"AcDbText")
  '(73 . 2)))

)

;;   main part   ;;
 (if 
(and
(setq pfx   (getstring "\n Prefix: 
")
      sfx   (getstring 
"\n Suffix: ")
      start (getint 
"\n Starting number: ")
      step  
(getint "\n Increment step: ")
      tht 
(getreal "\n Text heigh: ")))

(progn
     (command "_undo" "_be")


     (prompt "\n Select rectangles in the 
right order:")
     (while
(setq sset 
(ssget "_+.:S:L"
    (list (cons 0 
"lwpolyline")
   (cons 90 
4)
   (cons 70 1))))
 (setq en (ssname sset 
0))
 (setq pts (vl-remove-if 'not (mapcar '(lambda(x)(if (= 10 (car 
x))(cdr x)))(entget en)))
  cpt (trans (midpt (car pts)(caddr 
pts)) 1 0))
  (emake_txt  cpt (strcat pfx (itoa start) sfx) 
tht)
 (setq start (+ start step))
 )

)
   )


(*error* nil)
 (princ)
) ;_ end of defun
(prompt 
"\n\t---\tType INR to execute  \t---")
(prin1)

May 25, 2013

Then go through the code and find a line where

program is fails, otherwise i need drawing to see

the problem, nothing else

May 25, 2013

this line should read like this

   '(7 . "Standard")[b]; change on your  text style here[/b]

I believe when you copy and paste the code . the line inadvertently end up like this

   '(7 . "Standard"); change on your 
text style here

Anyhoo. here's a short code [demo code] UPDATED

(defun c:NRI ( /  *IntGet1 sn ss i e sum verts ptList p )
;;	pBe 25May2013	;;;
[color="blue"](defun *IntGet1 (fn msg def)
(setq type_ (vl-symbol-name (type def)))
 	(initget 6)
 	(setq val ((eval fn) (strcat msg " <" (vl-some '(lambda (x)
                (if (eq (Car x) type_)(eval (cadr x))))
                (list '("REAL" (rtos def 2 2))' ("INT" (itoa def)) '("STR" def))) ">: ")))
 (if (or (null val)
                (eq "" val))
                 def val))
(foreach Var '(("TxtHt" 1.0) ("sn" 1) ("pref" "X"))
     (if (setq dflt (eval (read (car var))))
         	  dflt (set (read (car var)) (cadr var))
))
(setq TxtHt   (*intget1 'getreal "\nEnter text height" TxtHt)
     sn      (*intget1 'getint "\nEnter Start Number" sn)[/color]
     pref    (strcase (*intget1 'getstring "\nEnter Start Number" pref)))
 
(if (setq i -1 ss (ssget '((0 . "LWPOLYLINE"))))  
(repeat (sslength ss)
           (setq e     (ssname ss (setq i (1+ i)))
                 sum   '(0 0)
                 verts (cdr (assoc 90 (entget e))))
           (setq ptList
                      (mapcar 'cdr
                              (vl-remove-if-not
                                    '(lambda (x) (= (car x) 10))
                                    (entget e))))
           (foreach x ptList (setq sum (mapcar '+ x sum)))
    (setq p (mapcar '/ sum (list verts  verts)))
	(entmakex
	  (list
	    (cons 0 "TEXT")
	    (cons 10 p)
	    (cons 11 p)
	    (cons 40 TxtHt)
	    '(50 . 0.0)
	    '(72 . 4)
	    '(73 . 3)
	    (cons 1[color="blue"][b] (Strcat pref " " (itoa sn))[/b][/color]
	          )
	    )
	  )
 		(setq sn (1+ sn))
	)
 )
(princ)
)

HTH

Edited May 25, 2013 by pBe
Sequence and prefix

May 25, 2013

Thanks Patrick, your demo code is much shorter than mine,

but without of seeing his sample drawing, anything is just a guess,

probably may be duplicate verices, or rectangles weren't closed

or some other things in there, who knows?

Cheers

May 25, 2013

..... but without of seeing his sample drawing, anything is just a guess, probably may be duplicate verices, or rectangles weren't closed or some other things in there, who knows?

You are right about that . Lately that's all we ever do based on the recent requests/request-ers

May 25, 2013

Hi Fixo,

My sincere apologies to you. Patrick was right , I pasted the program with word warp on in Notepad and did not notice the error.

There is no error now.

But I will still need to select the rectangles one by one and I have about 80 to 100 rectangles to select in the drawing.

Hope its not too much to ask if you can modify it so that I can do a fence selection.

Thanks

Regards

Kenbe

Then go through the code and find a line where
program is fails, otherwise i need drawing to see

the problem, nothing else

May 25, 2013

Hi Patrick,

Thanks for the code!! That is what I basically need.

Is it possible to reverse the numbering sequence--my first selected rectangle became the last to be numbered.

Also where can I modified the program to always add a prefix "X" to the numer.

Thanks

Regards

Kenbe

this line should read like this

   '(7 . "Standard")[b]; change on your  text style here[/b]

I believe when you copy and paste the code . the line inadvertently end up like this

   '(7 . "Standard"); change on your 
text style here

Anyhoo. here's a short code [demo code]

(defun c:demo ( / TxtHt sn ss i e sum verts ptList p )
(initget 7)
(if (and
     (setq TxtHt (getreal "\nEnter Text Height: "))
     (setq sn (initget 7)
           sn (getint "\nEnter Start Number: ")
     )
     (setq ss (ssget '((0 . "LWPOLYLINE"))))
   )

(repeat (setq i (sslength ss))
           (setq e     (ssname ss (setq i (1- i)))
                 sum   '(0 0)
                 verts (cdr (assoc 90 (entget e))))
           (setq ptList
                      (mapcar 'cdr
                              (vl-remove-if-not
                                    '(lambda (x) (= (car x) 10))
                                    (entget e))))
           (foreach x ptList (setq sum (mapcar '+ x sum)))
    (setq p (mapcar '/ sum (list verts  verts)))
	(entmakex
	  (list
	    (cons 0 "TEXT")
	    (cons 10 p)
	    (cons 11 p)
	    (cons 40 TxtHt)
	    '(50 . 0.0)
	    '(72 . 4)
	    '(73 . 3)
	    (cons 1 (itoa sn))
	          
	    )
	  )
 		(setq sn (1+ sn))
	)
       )
(princ)
)

HTH

May 25, 2013

Hi Patrick,
Thanks for the code!! That is what I basically need.

Is it possible to reverse the numbering sequence--my first selected rectangle became the last to be numbered.

Also where can I modified the program to always add a prefix "X" to the numer.

Thanks

Regards

Kenbe

X and space then number? "X 1" or "X1"? or are you wanting to be prompted for string prefix?

CODE updated: Sequence and prefix "X"

Edited May 25, 2013 by pBe

May 25, 2013

Hi Patrick,

Thanks for everything. The code that you updated is what I have in mind!!!

Have a good Day..

Regards

kenbe

X and space then number? "X 1" or "X1"? or are you wanting to be prompted for string prefix?

CODE updated: Sequence and prefix "X"

Sign In

Autonumbering of selected rectangles

Recommended Posts

KENBE

ReMark

KENBE

fixo

KENBE

fixo

pBe

fixo

pBe

KENBE

KENBE

pBe

KENBE

Join the conversation

Tutorials

Forums

Activity