Creating A block that "counts'

February 24, 2011

is it possible to give a block certain attributes so as when i insert it it how would you say it counts?

Example i draw a rectangle and put the number 01 in it. can i create this as a block so when i insert the block again the number has increased by on unit. or copy the block it increase by one unit?

There is a similair comand in microvellum if anyone knows it.

Or Am i dreaming.

February 24, 2011

I think it's possible with lisp.

The question is, what's gonna happen if you delete one of these blocks?

What's your purpose? Just count them? Or would you like some label to number them?

Regards,

SB

February 24, 2011

would this be for keeping track of quantities?

say you put 11 blocks in, and a defpoints "11" txt shows in the middle of the block.

do all blocks have the same # on them (amount inserted) or go 1,2,3,4------>etc

if you delete one, it updates to "10".

is that what you're getting at?

February 24, 2011

is it possible to give a block certain attributes so as when i insert it it how would you say it counts?
Example i draw a rectangle and put the number 01 in it. can i create this as a block so when i insert the block again the number has increased by on unit. or copy the block it increase by one unit?

There is a similair comand in microvellum if anyone knows it.

Or Am i dreaming.

Maybe...but I've only tested this quickly...

Create your block, use the DATAEXTRACTION command to create a table that counts the number of insertions...

Then add this table to the block definition...

It looks like you still might need an additional copy of the table floating around in order to update it when needed.

February 25, 2011

example i have 25 carcass's that i need to label instead of inserting text on each carcass on by one just easier to click is succession. the number will increase 1,2,3,4,5

February 25, 2011

Just use a lisp part 1 is to find out last number part two what number to start at, part 3 insert block with new number

Hers an example uses block setout_point with 1 attribute

(defun c:SETOUTPT ()
(setvar "cmdecho" 0)
; (setq temperr *error*)
; (setq *error* trap)
(if (= dwgscale nil) 
(setq dwgscale (/ (getreal "\n Enter drawing scale ")1000.0 ))
)

(setq os (getvar "osmode"))
; (command "undo" "m")
(if (= pno nil) (setq pno 1))
(prompt "\nEnter Setout Point No.<")(prin1 pno)(prompt ">:")
(setq newpno (getint))
(if (= newpno nil) (setq newpno pno))
(setq ss1 (ssget "x" '((2 . "setout_point"))))
(if (/= ss1 nil)
(progn
(setq n (sslength ss1))
(setq t1 1)
(while t1
(setq index 0)
(setq t2 1)
(while t1
(setq en (ssname ss1 index))
(setq index (+ index 1))
(setq el (entget en))
(setq en1 (entnext en))
(setq el1 (entget en1))
(setq att (cdr (assoc 1 el1)))
(setq testpno (itoa newpno))
(if (= att testpno)
(progn
(prompt "\nSetout Point No.")(prin1 newpno)(prompt " already exists.")
(prompt "\nEnter new number:")
(setq newpno (getint))
(setq t2 nil)
);progn 
;else
(if (= index n)
(progn
(setq t1 nil)
(setq t2 nil)
);progn
);if = index
);if = att
);while t2
);while t1
);progn
);if ss1 /= nil
(setq pt1 (getpoint "\nPick setout point: "))
(command "osmode" 0) 
(prompt "\nPoint for circle: ")
(command "insert" "setout_point_no" pause dwgscale "" "" newpno)
(setq pt2 (getvar "lastpoint"))
(command "insert" "setout_point" pt1 (* 0.5 dwgscale) "" "" newpno)
(setq ang (angle pt1 pt2))
(setq pt3 (polar pt2 (- ang pi) (* 3.2 dwgscale))) ; text ht 2.5
(command "line" pt1 pt3 "")
(setq pno (+ newpno 1))
(setvar "osmode" os)
; (setq *error* temperr)
(princ)
)

February 25, 2011

Here 's the balloon lisp i use. Maybe u'll find it usefull.

It's not attaching to blocks or anything, so you can use it for any block or shape you want to number.

; Macro to simplify the construction of item-number labels.
; The size of the dot, text and balloon are based on the dimensioning
; variables. If DIMASZ is set to zero the dot is not drawn. If the
; current text style has a fixed height then that height is used to
; scale the balloon and its text.
; A null response to the first prompt ("From point: ") will terminate
; the command.
; Numeric text is incremented to aid itemising components of a drawing
(defun C:BALLOON (/ a b c d h l r txt)
 ; a : Leader start
 ; b : Balloon centre
 ; c : Leader end point
 ; d : Dot diameter
 ; h : Text height
 ; r : Balloon radius
 ; Store and set system variables
 (setq ce (getvar "CMDECHO"))
 (setq bm (getvar "BLIPMODE"))
 (setvar "CMDECHO" 0)
 (setvar "BLIPMODE" 0)
 ; Set dot diameter to fifth of arrow head size
 (setq d (* (getvar "DIMSCALE") (getvar "DIMASZ") 0.2))
 ; Check whether the current text style has a fixed height
 (setq ts (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
 (if (zerop ts)
     ; Set balloon radius based on dimension text height
     (setq r (* (getvar "DIMSCALE") (getvar "DIMTXT") 1.2)
           h (* (getvar "DIMSCALE") (getvar "DIMTXT"))
     )
     ; Set balloon radius based on current style text height
     (setq r (* ts 1.2))
 )
 ; Get start point (a null response will terminate function)
 (setq a (getpoint "\nFrom point: "))
 (if a
     (progn
      ; Get balloon cntre disallowing null responses
      (initget 1)
      (setq b (getpoint a "\nBalloon centre: "))
      (if (null oldtxt) (setq oldtxt "1"))
      (prompt (strcat "\nText <" oldtxt ">: "))
      (setq txt (getstring))
      (if (= txt "") (setq txt oldtxt))
      (setvar "BLIPMODE" 0)
      ; Draw dot if DIMASZ is set
      (if (> d 0) (command "DONUT" "0" d a ""))
      ; Calculate point where leader crosses balloon
      (setq c (polar a
                     (angle a b)
                     (- (distance a b) r)
              )
      )
      ; Draw leader
      (command "LINE" a c "")
      ; Draw balloon
      (command "CIRCLE" b r)
      ; Draw text (checking against fixed text height)
      (if (zerop ts)
          (command "TEXT" "M" b h "0" txt)
          (command "TEXT" "M" b "0" txt)
      )
      (setq oldtxt (itoa (1+ (atoi txt))))
     )
 )
 ; Reset system variables
 (setvar "BLIPMODE" bm)
 (setvar "CMDECHO" ce)
 (princ)
)

April 1, 2011

I believe this was created by VVA a while back.

This is probably the closest LISP routine that meets your needs. Its pretty awesome.

1) Select a block that has an Attribute. A little dialog box appears and asks you which Attribute you would like to increment.

2) then it asks you a couple of questions regarding how you would like to insert the block (scale...)

3) asks what starting number to start incrementing from...

NOTE - there are also options to have a prefix &/or Suffix

4) place copies of the block and as you do, the ATT will automatically increment for you.

(defun c:binc (/ oldStart oldPref oldSuf oldEcho oldInc
       oldSize oldBlock temBl *error* att attr apnum:tag pt )

;==== Local functions ============
 (vl-load-com)
 (defun *error* (msg)(setvar "CMDECHO" oldEcho)(setvar "ATTDIA" att)(setvar "ATTREQ" attr)(princ)); end *error*
 (defun mydcl (zagl info-list / fl ret dcl_id)
   (if (null zagl)(setq zagl "Select")) ;_ end of if
   (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
   (setq ret (open fl "w"))
   (mapcar '(lambda (x) (write-line x ret))
           (list "mip_msg : dialog { "
                 (strcat "label=\"" zagl "\";")
                 " :list_box {"
                 "alignment=top ;"
                 "width=51 ;"
                 (if (> (length info-list) 26)
                     "height= 26 ;"
                     (strcat "height= " (itoa (+ 3 (length info-list))) ";")
                 ) ;_ end of if
                 "is_tab_stop = false ;"
                 "key = \"info\";}"
                 "ok_cancel;}"
           ) ;_ end of list
   ) ;_ end of mapcar
   (setq ret (close ret))
   (if (and (not(minusp(setq dcl_id (load_dialog fl))))
     (new_dialog "mip_msg" dcl_id))
           (progn
               (start_list "info")(mapcar 'add_list info-list)
               (end_list)(set_tile "info" "0")
               (setq ret (car info-list))
               (action_tile "info" "(setq ret (nth (atoi $value) info-list))")
               (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))")
               (action_tile "accept" "(done_dialog 1)")(start_dialog)
           ) ;_ end of progn
   ) ;_ end of if
   (unload_dialog dcl_id)(vl-file-delete fl) ret) ;_ end of defun
 (defun mip-conv-to-str (dat)
 (cond ((= (type dat) 'INT)(setq dat (itoa dat)))
        ((= (type dat) 'REAL)(setq dat (rtos dat 2 12)))
       ((null dat)(setq dat ""))
       (t (setq dat (vl-princ-to-string dat)))))
;; obj - Ename or Vla object of block
;; att_list - list ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...)
;;                 Tag_Name - string
;;                    Value - string
(defun mip-block-setattr-bylist (obj att_list / txt lst)
(if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
(setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list))
 (if (and obj
          (not(vlax-erased-p obj))
          (= (vla-get-ObjectName obj) "AcDbBlockReference")
   (eq :vlax-true (vla-get-HasAttributes obj))
   (vlax-property-available-p obj 'Hasattributes)
   (vlax-write-enabled-p obj)
     )
   (vl-catch-all-apply
     (function
(lambda ()
         (foreach at (vlax-invoke obj 'Getattributes)
           (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list))
             (vla-put-TextString at (cdr lst))
           )
           )
         )
       )
     )
   )
 )
 (defun get-all-atts (obj)
 (if (and obj
   (and (= (type obj) 'ENAME)
 (setq obj (vlax-ename->vla-object obj)))
          (vlax-property-available-p obj 'Hasattributes)
   (eq :vlax-true (vla-get-HasAttributes obj))
     )
   (vl-catch-all-apply
     (function
(lambda ()
  (mapcar (function (lambda (x)
        (cons (vla-get-TagString x)
       (vla-get-TextString x)
        )
      )
   )
   (append (vlax-invoke obj 'Getattributes)
    (vlax-invoke obj 'Getconstantattributes)
   )
  )
)
     )
   )
 )
)
(defun rec-pat (str temp)
 (cond
   ((= str "")(if (/= temp "")(list temp)))
   ((wcmatch (substr str 1 1) "[1234567890.]")
    (rec-pat (substr str 2) (strcat temp (substr str 1 1)))
   )
   (t (if (/= temp "")
       (cons temp (rec-pat str ""))
       (rec-pat (substr str 2) "")
      ) ;_ end of if
   )
 ) ;_ end of cond
) ;_ end of defun
 
;==== Local functions END ============
 
 (if(not apnum:Size)(setq apnum:Size 1.0))
 (if(not apnum:Num)(setq apnum:Num 1))
 (if(not apnum:Inc)(setq apnum:Inc 1))
 (if(not apnum:Pref)(setq apnum:Pref ""))
 (if(not apnum:Suf)(setq apnum:Suf ""))
 (setq  oldStart apnum:Num oldSize apnum:Size oldInc apnum:Inc
        oldPref apnum:Pref oldSuf apnum:Suf
        apnum:Block (mip-conv-to-str apnum:Block)
        apnum:tag (mip-conv-to-str apnum:tag)
        oldEcho (getvar "CMDECHO")
        att (getvar "ATTDIA") attr (getvar "ATTREQ")); end setq
 (setvar "ATTDIA" 0)(setvar "ATTREQ" 0)
 (setvar "CMDECHO" 0)
   (setq apnum:Pref
   (getstring T
     (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Pref"> :")))
 (if(= "" apnum:Pref)(setq apnum:Pref oldPref))
 (if(= " " apnum:Pref)(setq apnum:Pref ""))
 (setq apnum:Suf
   (getstring T
      (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Suf"> :")))
 (if(= "" apnum:Suf)(setq apnum:Suf oldSuf))
 (if(= " " apnum:Suf)(setq apnum:Suf ""))
 (if apnum:Block(setq oldBlock apnum:Block))
 (setq temBl
    (entsel(strcat "\nSelect block <"
        (if apnum:Block apnum:Block "not difined") "> > "))); end setq
 (cond
   ((or (and tembl (= 1 (cdr(assoc 66(entget(car temBl)))))
  (= "INSERT" (cdr(assoc 0(entget(car temBl)))))
  )
 (and apnum:Block (setq tembl (tblobjname "BLOCK" apnum:Block))
      (setq tembl (list tembl))
      )
 )
     (setq apnum:Block(cdr(assoc 2(entget(car temBl)))))
     ((lambda( / lst e1 ed ss i)
       (setq e1 (entnext (car temBl)))
       (while (AND e1
   (wcmatch (cdr (assoc 0 (setq ed (entget e1)))) "ATTRIB,ATTDEF")
     ) ;_ End of AND
  (setq lst (cons (cdr (assoc 2 ed)) lst))
  (setq e1 (entnext e1))
)
 (cond ((= 0 (length lst))(setq apnum:Block nil))
       ((= 1 (length lst))(setq apnum:tag (car lst)))
       (t (setq apnum:tag (mydcl "Select attribute" (acad_strlsort lst))))
       )
(terpri)(princ apnum:tag)
;;;Russian text
;;; ???????????? ????? ??????? ??? ???????????? ????? ???? ???????? ?????????
;;; ???????????? ??? (???????? ???????? ????????   D3SE/0-008A18B3:
;;;        ???????? ???????? D3SE/0-
;;;        ???????? ???????? B3 
;;;         1. ?? ???????? ???????? ????????? ??????? ? ???????
;;;                ???????? ???????? - 008A18
;;;         2. ? ???????? ???????? ?????????? ??? ????? ("008" "18")
;;;         3. ?? ??? ?? ????? ???????? ??????? ????? ? ???????????? ??????????????????? ????
;;;                    ?.?. 8, ? ?? 18
 
 (and
   (setq ss nil ss (ssget "_X" (list
   '(0 . "INSERT")
   (cons 2  apnum:Block)
   (cons 410 (getvar "CTAB")))))
   (setq lst nil i '-1)
   (progn
     (repeat (sslength ss)
        (setq lst (cons (ssname ss (setq i (1+ i))) lst))
       )
     lst
     )
        (setq apnum:Num (1+
      (apply
 'max
        (mapcar 'atoi
               (mapcar 'mip-conv-to-str        
        (mapcar '(lambda(f / mst)
     (setq mst (apply 'max (mapcar 'strlen f)))
     (car(vl-remove-if-not '(lambda(f1)(= mst (strlen f1))) f))
     )
        (mapcar '(lambda(z)(rec-pat z ""))
 (mapcar '(lambda(y)
         (vl-string-right-trim (mip-conv-to-str apnum:Suf)
  (vl-string-left-trim apnum:pref y)))
  (vl-remove-if 'null (mapcar '(lambda(x)(cdr(assoc (strcase apnum:tag)(get-all-atts x)))) lst)))
 )))))))
   );_and
 );_lambda
);_lambda
   ); end condition #2
   ((null (tblsearch "BLOCK" apnum:Block))
    (alert (strcat "Block " apnum:Block " not found"))
    (setq apnum:Block nil)
    ); end condition #0
   ((and apnum:Block(not temBl)(tblsearch "BLOCK" apnum:Block))
   (setq apnum:Block oldBlock)
    ); end condition #1
   
   (t
    (princ "\nBlock not contains attribute! ")
    (setq apnum:Block nil)
    ); end condition #3
   ); end cond
(princ "\nXXXXXXXXX")  
 (setq apnum:Num
   (getint
     (strcat "\nSpecify start number <"(itoa apnum:Num)">: ")))
 (if(null apnum:Num)(setq apnum:Num oldStart))
 (setq apnum:Inc
   (getint
     (strcat "\nSpecify increment <"(itoa apnum:Inc)">: ")))
 (if(null apnum:Inc)(setq apnum:Inc oldInc))
 (setq apnum:Size
   (getreal
     (strcat "\nSpecify block scale <"(rtos apnum:Size)">: ")))
 (if(null apnum:Size)(setq apnum:Size oldSize))
 
(terpri)(princ apnum:tag)(princ  " ZZZ ")(princ apnum:Block)
 
 (if (and apnum:Block apnum:tag)
   (progn
(while T
 (princ "\n>>> Pick insertion point or press Esc to quit <<<\n")
 (command "_-insert" apnum:Block "_s" apnum:Size pause "0")
  (mip-block-setattr-bylist (entlast)
    (list(cons (strcase (mip-conv-to-str apnum:tag))
               (strcat apnum:Pref(itoa apnum:Num)apnum:Suf))))
   (setq apnum:Num (+ apnum:Num apnum:Inc))
 ); end while
); end progn
   ); end if
 (setvar "ATTDIA" att)(setvar "ATTREQ" attr)
 (princ)
 )

Edited April 1, 2011 by troggarf

April 1, 2011

Here's another. I don't know who made this one - probably VVA again. You select the attribute that you want to increment. Then select the blocks that contain that attribute and it will increment only the blocks that you select.

This a good compliment to the one above because you can use this one after you have placed the blocks.

~enjoy

(defun c:mnum(/ stStr stNum nLen cAtr dLst blName
      fLst blLst blSet aName sLst lZer aStr)
 (vl-load-com)
 (if
   (and
     (setq stStr(getstring "\nSpecify start number: "))
     (setq stNum(atoi stStr))
     (setq nLen(strlen stStr))
     ); end and
   (progn
     (if
(and
   (setq cAtr(nentsel "\nPick attribute > "))
   (= "ATTRIB"(cdr(assoc 0(setq dLst(entget(car cAtr))))))
  ); end and
(progn
  (setq blName
    (vla-get-Name
       (vla-ObjectIDToObject
	  (vla-get-ActiveDocument
	     (vlax-get-acad-object))
	        (vla-get-OwnerID
	           (vlax-ename->vla-object(car cAtr)))))
	fLst(list '(0 . "INSERT")(cons 2 blName))
	aName(cdr(assoc 2 dLst))
	); end setq
  (princ "\n<<< Select blocks to number >>> ")
  (if
    (setq blSet(ssget fLst))
    (progn
     (setq sLst
                   (mapcar 'vlax-ename->vla-object
	      (mapcar 'car
	       (vl-sort
	        (vl-sort
	          (mapcar '(lambda(x)(list x(cdr(assoc 10(entget x)))))
	            (vl-remove-if 'listp 
                             (mapcar 'cadr(ssnamex blSet))))
	                '(lambda(a b)(<(caadr a)(caadr b))))
		          '(lambda(a b)(>(cadadr a)(cadadr b)))))))
     (foreach i sLst
       (setq lZer "")
       (repeat(- nLen(strlen(itoa stNum)))
	 (setq lZer(strcat lZer "0"))
	 ); end repeat
       (setq atLst
	      (vlax-safearray->list
		 (vlax-variant-value
		   (vla-GetAttributes i))))
       (foreach a atLst
	 (if
	   (= aName(vla-get-TagString a))
	      (vla-put-TextString a
		(strcat lZer(itoa stNum)))
	   ); end if
	 ); end foreach
	 (setq stNum(1+ stNum))
       ); end foreach
      ); end progn
    (princ "\nEmpty selection! Quit. ")
    ); end if
  ); end progn
(princ "\nThis isn't an attribute! Quit. ")
); end if
     ); end progn
   (princ "\nInvalid start number! Quit. ")
   ); end if
 (princ)
 ); end of c:mnum

Sign In

Creating A block that "counts'

Recommended Posts

CiCAD

Sittingbull

adamsnez

rkmcswain

CiCAD

BIGAL

Sittingbull

troggarf

troggarf

Join the conversation

Tutorials

Forums

Activity