Increment numbering with block

[fondracek]

Hi guys,

 

I am new to LISP and CAD customization at all, so what I am asking for is a guide where to look and how to approach my problem. Sorry for my English, I am not a native speaker.

 

My goal is to create button which will insert a block into my drawing (I know how to do that), block is a simple circle with a number, which represent a reference for some element, a stud for example.

 

What it should do....

 

1) click a my made button which start inserting a block with a midpoint (done)

2) click in a drawing and insert the block to a anyplace I want (dont know how to continue inserting without hitting the button again)

3) inserting the block will still continue but now it will be second one(3rd,4th etc.) and the number in a circle will be increasing by 1

4) I would like to specify from which number the increment numbering should start.

[ReMark]

Have you seen Lee Mac's Incremental Numbering Suite lisp program? Might be of some interest to you.

 

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

[Tharwat]

Welcome to CADTutor .

 

Are you talking about Attributed Block ? and I guess it is Axes indicators or a references , isn't it ?

 

Anyway , upload a sample drawing obtaining that block .

 

What you mean by inserting the block with a midpoint ?

[fondracek]

It do not needed to be Attributed Block I suppose.

 

What you mean by inserting the block with a midpoint ?

 

Just when I am inserting the block, it sticks on a cursor with a circle midpoint

 

I found out this video on YT (jump to 3:20)

 

 

I am trying to do nearly the same but the numbers would be in a circle.

studref.dwg

[Tharwat]

Try this program and let me know .

 

(defun c:Test  (/ i p)
 ;;    Tharwat 14.01.2014    ;;
 (if (setq i (getint "\n Specify the Increment Number :"))
   (while (setq p (getpoint "\n Specify Point :"))
     (entmake (list '(0 . "CIRCLE")
                    '(8 . "_ADEPT-Supports (Only PL)")
                    (cons 10 p)
                    '(40 . 200.0)))
     (entmake (list '(0 . "MTEXT")
                    '(100 . "AcDbEntity")
                    '(100 . "AcDbMText")
                    '(8 . "_ADEPT-REFS (Studs)")
                    (cons 1
                          (if (<= i 9)
                            (strcat "0" (itoa i))
                            (itoa i)))
                    (cons 7 (getvar 'TEXTSTYLE))
                    (cons 10 p)
                    '(40 . 150.0)
                    '(50 . 0.)
                    '(71 . 5)
                    '(72 . 5)
                    '(73 . 1)))
     (setq i (1+ i))
     )
   )
 (princ)
 )

[fondracek]

Try this program and let me know .

 

(defun c:Test  (/ i p)
 ;;    Tharwat 14.01.2014    ;;
 (if (setq i (getint "\n Specify the Increment Number :"))
   (while (setq p (getpoint "\n Specify Point :"))
     (entmake (list '(0 . "CIRCLE")
                    '(8 . "_ADEPT-Supports (Only PL)")
                    (cons 10 p)
                    '(40 . 200.0)))
     (entmake (list '(0 . "MTEXT")
                    '(100 . "AcDbEntity")
                    '(100 . "AcDbMText")
                    '(8 . "_ADEPT-REFS (Studs)")
                    (cons 1
                          (if (<= i 9)
                            (strcat "0" (itoa i))
                            (itoa i)))
                    (cons 7 (getvar 'TEXTSTYLE))
                    (cons 10 p)
                    '(40 . 150.0)
                    '(50 . 0.)
                    '(71 . 5)
                    '(72 . 5)
                    '(73 . 1)))
     (setq i (1+ i))
     )
   )
 (princ)
 )

 

Yhea, it works just fine man. Thanks a lot. I have more references I can do, but with this as a template it should be easy and hopefully catch trick or two

[Tharwat]

Yhea, it works just fine man. Thanks a lot. I have more references I can do, but with this as a template it should be easy and hopefully catch trick or two

 

You are welcome

 

Don't hesitate to ask for any help if you feel that you want to

[BIGAL]

Here is a variation that uses Alphas and numbers.

 

; bubble pt num
; BY ALAN H AUG 2014
(defun make_circle ()
 (entmake (list (cons 0 "CIRCLE")
 (cons 8 "0")
 (cons 10 (list 0 0 0))
 (cons 40 3.25)  ; rad
 (cons 210 (list 0 0 1))
 (cons 62 256)
 (cons 39 0)
 (cons 6 "BYLAYER")
  )
 )
)     ; DEFUN
(defun make_sq ()
 (setq vertexList
 (list
 (list -3.25 -3.25 0.)
 (list 3.25 -3.25 0.)
 (list 3.25 3.25 0.)
 (list -3.25 3.25 0.)
 ))
 (entmake
   (append 
   (list '(0 . "LWPOLYLINE")
   '(100 . "AcDbEntity")
   '(100 . "AcDbPolyline")
   (cons 90 (length vertexList))
   (cons 70 1)   ; 1 closed : 0 open
   (cons 8 "0")
   (cons 38 0.0)
   (cons 210 (list 0.0 0.0 1.0))
   )
   (mapcar '(lambda (pt) (cons 10 pt)) vertexList)
   )
 )
)     ; defun
(defun Make_bubble ( )
 (entmake (list (cons 0 "BLOCK")
   (cons 2 Blkname)
   (cons 70 2)
   (cons 10 (list 0 0 0))
   (CONS 8 "0")
 ))
 (if (= resp "C")
 (make_circle)
 (make_sq)
 )
 (entmake (list (cons 0 "ATTDEF")
      (cons 8 "0")
      (cons 10 (list 0 0 0))
      (cons 1 "1")  ; default value
      (cons 2 blkname)  ; nblock name
      (cons 3 "Ptnum")  ; tag name
      (cons 6 "BYLAYER")
      (cons 7 "STANDARD") ;text style
      (cons 8 "0")  ; layer
      (cons 11 (list 0.0 0.0 0.0)) ; text insert pt
      (cons 39 0)
      (cons 40 3.5)  ; text height
      (cons 41 1)  ; X scale
      (cons 50 0)  ; Text rotation
      (cons 51 0)  ; Oblique angle
      (cons 62 256)  ; by layer color 
      (cons 70 0)
      (cons 71 0)  ;Text gen flag
      (cons 72 1)  ; Text Justify hor 1 center
      (cons 73 0)  ; field length
      (cons 74 2)  ; Text Justify ver 2 center
      (cons 210 (list 0 0 1))
 ))
 (entmake (list (cons 0 "ENDBLK")))
 (princ)

)
(defun C:bub (/ ptnum ptnumb pt pt2 oldsnap chrnum sc curspace)
 (if (= 1 (getvar 'cvport))
 (setq sc 1.0)
 (setq sc (/ 1000.0 (getreal "\nEnter plotting scale")))
 )
 (setq oldsnap (getvar "osmode"))
 (setvar "textstyle" "standard")
 (setq ptnum (getstring "\nEnter Pt Number or alpha"))
 (setq chrnum (ascii (substr ptnum 1 1))) ; 1st character is number
 (if (< chrnum 58)
 (setq ptnumb (atof ptnum))  ;convert back to a number 
 )

 (while (setq pt (getpoint "\Pick end of line Enter to exit"))
   (setq pt2 (polar pt (/ pi 2.0) 3.25))
   (setvar "osmode" 0)
   (if (< chrnum 58)
     (progn
(command "-insert"
  blkname
  pt
  sc
  ""
  0
  (rtos ptnumb 2 0)
)
(setq ptnumb (+ ptnumb 1))
     )
     (progn
(command "-insert"
  blkname
  pt
  sc
  ""
  0
  (chr chrnum)
)
(setq chrnum (+ chrnum 1))
     )
   )
   (command "move" "L" "" pt pt2)
   (setvar "osmode" 1)
 )
 (setvar "osmode" oldsnap)
 (princ)
)     ; end defun
;;;;;; 
    ; program starts here checking 
(alert "Type Bub to repeat\nYou can do alpha's or numbers\nSquare or circles")
(initget 6 "S s C c")
(setq resp (strcase
     (Getkword "\nDo you want Circle or Square C or S <C> ")
   )
)
(if (or (= resp "C") (= resp nil))
 (setq blkname "SETOUT_POINT_NO")
 (setq blkname "SETOUT_POINT_NOSQ")
)

(if (/= (tblsearch "BLOCK" blkname) NIL)
(PRINC "FOUND")    ; block exists
(Make_bubble)
)
(C:BUB)
(princ)

[stevesfr]

Here is a variation that uses Alphas and numbers.

 

; bubble pt num
; BY ALAN H AUG 2014
(defun make_circle ()
(entmake (list (cons 0 "CIRCLE")
(cons 8 "0")
(cons 10 (list 0 0 0))
(cons 40 3.25) ; rad
(cons 210 (list 0 0 1))
(cons 62 256)
(cons 39 0)
(cons 6 "BYLAYER")
)
)
) ; DEFUN
(defun make_sq ()
(setq vertexList
(list
(list -3.25 -3.25 0.)
(list 3.25 -3.25 0.)
(list 3.25 3.25 0.)
(list -3.25 3.25 0.)
))
(entmake
(append 
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length vertexList))
(cons 70 1) ; 1 closed : 0 open
(cons 8 "0")
(cons 38 0.0)
(cons 210 (list 0.0 0.0 1.0))
)
(mapcar '(lambda (pt) (cons 10 pt)) vertexList)
)
)
) ; defun
(defun Make_bubble ( )
(entmake (list (cons 0 "BLOCK")
(cons 2 Blkname)
(cons 70 2)
(cons 10 (list 0 0 0))
(CONS 8 "0")
))
(if (= resp "C")
(make_circle)
(make_sq)
)
(entmake (list (cons 0 "ATTDEF")
(cons 8 "0")
(cons 10 (list 0 0 0))
(cons 1 "1") ; default value
(cons 2 blkname) ; nblock name
(cons 3 "Ptnum") ; tag name
(cons 6 "BYLAYER")
(cons 7 "STANDARD") ;text style
(cons 8 "0") ; layer
(cons 11 (list 0.0 0.0 0.0)) ; text insert pt
(cons 39 0)
(cons 40 3.5) ; text height
(cons 41 1) ; X scale
(cons 50 0) ; Text rotation
(cons 51 0) ; Oblique angle
(cons 62 256) ; by layer color 
(cons 70 0)
(cons 71 0) ;Text gen flag
(cons 72 1) ; Text Justify hor 1 center
(cons 73 0) ; field length
(cons 74 2) ; Text Justify ver 2 center
(cons 210 (list 0 0 1))
))
(entmake (list (cons 0 "ENDBLK")))
(princ)

)
(defun C:bub (/ ptnum ptnumb pt pt2 oldsnap chrnum sc curspace)
(if (= 1 (getvar 'cvport))
(setq sc 1.0)
(setq sc (/ 1000.0 (getreal "\nEnter plotting scale")))
)
(setq oldsnap (getvar "osmode"))
(setvar "textstyle" "standard")
(setq ptnum (getstring "\nEnter Pt Number or alpha"))
(setq chrnum (ascii (substr ptnum 1 1))) ; 1st character is number
(if (< chrnum 58)
(setq ptnumb (atof ptnum)) ;convert back to a number 
)

(while (setq pt (getpoint "\Pick end of line Enter to exit"))
(setq pt2 (polar pt (/ pi 2.0) 3.25))
(setvar "osmode" 0)
(if (< chrnum 58)
(progn
(command "-insert"
blkname
pt
sc
""
0
(rtos ptnumb 2 0)
)
(setq ptnumb (+ ptnumb 1))
)
(progn
(command "-insert"
blkname
pt
sc
""
0
(chr chrnum)
)
(setq chrnum (+ chrnum 1))
)
)
(command "move" "L" "" pt pt2)
(setvar "osmode" 1)
)
(setvar "osmode" oldsnap)
(princ)
) ; end defun
;;;;;; 
; program starts here checking 
(alert "Type Bub to repeat\nYou can do alpha's or numbers\nSquare or circles")
(initget 6 "S s C c")
(setq resp (strcase
(Getkword "\nDo you want Circle or Square C or S <C> ")
)
)
(if (or (= resp "C") (= resp nil))
(setq blkname "SETOUT_POINT_NO")
(setq blkname "SETOUT_POINT_NOSQ")
)

(if (/= (tblsearch "BLOCK" blkname) NIL)
(PRINC "FOUND") ; block exists
(Make_bubble)
)
(C:BUB)
(princ)

 

Where are the blocks that go with this lisp??????????

[BIGAL]

It should make the block if it does not exist. It checks to see if already exists say ran once before. Just tested again in my Blank-blank dwg it has absolutely nothing in it worked fine

[stevesfr]

@BIGAL

you are correct, program is fine. my bad, sorry for comment.

S

[symoin]

On 1/15/2015 at 5:05 AM, BIGAL said:

Here is a variation that uses Alphas and numbers.

 

 

; bubble pt num
; BY ALAN H AUG 2014
(defun make_circle ()
 (entmake (list (cons 0 "CIRCLE")
 (cons 8 "0")
 (cons 10 (list 0 0 0))
 (cons 40 3.25)  ; rad
 (cons 210 (list 0 0 1))
 (cons 62 256)
 (cons 39 0)
 (cons 6 "BYLAYER")
  )
 )
)     ; DEFUN
(defun make_sq ()
 (setq vertexList
 (list
 (list -3.25 -3.25 0.)
 (list 3.25 -3.25 0.)
 (list 3.25 3.25 0.)
 (list -3.25 3.25 0.)
 ))
 (entmake
   (append 
   (list '(0 . "LWPOLYLINE")
   '(100 . "AcDbEntity")
   '(100 . "AcDbPolyline")
   (cons 90 (length vertexList))
   (cons 70 1)   ; 1 closed : 0 open
   (cons 8 "0")
   (cons 38 0.0)
   (cons 210 (list 0.0 0.0 1.0))
   )
   (mapcar '(lambda (pt) (cons 10 pt)) vertexList)
   )
 )
)     ; defun
(defun Make_bubble ( )
 (entmake (list (cons 0 "BLOCK")
   (cons 2 Blkname)
   (cons 70 2)
   (cons 10 (list 0 0 0))
   (CONS 8 "0")
 ))
 (if (= resp "C")
 (make_circle)
 (make_sq)
 )
 (entmake (list (cons 0 "ATTDEF")
      (cons 8 "0")
      (cons 10 (list 0 0 0))
      (cons 1 "1")  ; default value
      (cons 2 blkname)  ; nblock name
      (cons 3 "Ptnum")  ; tag name
      (cons 6 "BYLAYER")
      (cons 7 "STANDARD") ;text style
      (cons 8 "0")  ; layer
      (cons 11 (list 0.0 0.0 0.0)) ; text insert pt
      (cons 39 0)
      (cons 40 3.5)  ; text height
      (cons 41 1)  ; X scale
      (cons 50 0)  ; Text rotation
      (cons 51 0)  ; Oblique angle
      (cons 62 256)  ; by layer color 
      (cons 70 0)
      (cons 71 0)  ;Text gen flag
      (cons 72 1)  ; Text Justify hor 1 center
      (cons 73 0)  ; field length
      (cons 74 2)  ; Text Justify ver 2 center
      (cons 210 (list 0 0 1))
 ))
 (entmake (list (cons 0 "ENDBLK")))
 (princ)

)
(defun C:bub (/ ptnum ptnumb pt pt2 oldsnap chrnum sc curspace)
 (if (= 1 (getvar 'cvport))
 (setq sc 1.0)
 (setq sc (/ 1000.0 (getreal "\nEnter plotting scale")))
 )
 (setq oldsnap (getvar "osmode"))
 (setvar "textstyle" "standard")
 (setq ptnum (getstring "\nEnter Pt Number or alpha"))
 (setq chrnum (ascii (substr ptnum 1 1))) ; 1st character is number
 (if (< chrnum 58)
 (setq ptnumb (atof ptnum))  ;convert back to a number 
 )

 (while (setq pt (getpoint "\Pick end of line Enter to exit"))
   (setq pt2 (polar pt (/ pi 2.0) 3.25))
   (setvar "osmode" 0)
   (if (< chrnum 58)
     (progn
(command "-insert"
  blkname
  pt
  sc
  ""
  0
  (rtos ptnumb 2 0)
)
(setq ptnumb (+ ptnumb 1))
     )
     (progn
(command "-insert"
  blkname
  pt
  sc
  ""
  0
  (chr chrnum)
)
(setq chrnum (+ chrnum 1))
     )
   )
   (command "move" "L" "" pt pt2)
   (setvar "osmode" 1)
 )
 (setvar "osmode" oldsnap)
 (princ)
)     ; end defun
;;;;;; 
    ; program starts here checking 
(alert "Type Bub to repeat\nYou can do alpha's or numbers\nSquare or circles")
(initget 6 "S s C c")
(setq resp (strcase
     (Getkword "\nDo you want Circle or Square C or S <C> ")
   )
)
(if (or (= resp "C") (= resp nil))
 (setq blkname "SETOUT_POINT_NO")
 (setq blkname "SETOUT_POINT_NOSQ")
)

(if (/= (tblsearch "BLOCK" blkname) NIL)
(PRINC "FOUND")    ; block exists
(Make_bubble)
)
(C:BUB)
(princ)

 

Hi Bigal,

I tried your code for Numbers and Alpha... but for both the options I am getting only the number "1" and not the sequence.

Could you please guide in solving this issue.

 

[BIGAL]

That version should work the new version uses the multigetvals and radio buttons.lsp for input.

 

Can you post your dwg really no idea have used this for years and with multiple users, can change the message when picking it was for our required majority labelling.

 

I need to revisit adding find last etc. Another post comes to mind find missing numbers renumber move numbers etc.

Edited September 11, 2020 by BIGAL