Help with attribute of the block

[AbdRF]

Hi all,

Hope you all are doing well. I want to make a dynamic block (a circular ring with a numeric attribute in the centre of the ring). Is there any way that it can be made such that when user enter it in the drawing, the attribute can be incremented &decremented by clicking or by some button (each click should increment/decrement by +1/-1)?

Any valuable suggestion/advise is welcome
Thanks

[Emmanuel Delay]

Something like this?

 

Make sure you adapt this:

;; ... TO DO: adapt this so that it matches the attribute of your block
  (setq tag "NUM")

 

Command IDA (for Increment Decrement Attribute)

 

Clicking somewhere left of the block (compared to the insert point of the block) decreases the attribute, clicking on the right increases it.

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; http://www.lee-mac.com/attributefunctions.html

;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.
(defun LM:setattributevalue ( blk tag val / enx )
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx))
                (progn
                    (entupd blk)
                    val
                )
            )
            (LM:setattributevalue blk tag val)
        )
    )
)

;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.
(defun LM:getattributevalue ( blk tag / val enx )
    (while
        (and
            (null val)
            (setq blk (entnext blk))
            (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
        )
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (setq val (cdr (assoc 1 (reverse enx))))
        )
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Increment Decrement Attribute
(defun c:ida ( / tag ent pp inc)
  ;; SETTINGS
  ;; Attribute tag.  TO DO: adapt this so that it matches the attribute of your block
  (setq tag "NUM")
 
  (while (setq ent (entsel "\nClick right of the circle/block to increment, left to decrement: "))
    (setq pp (cadr ent))
    (setq inc
      (-  
        (nth 0 pp)                                    ;; pick point, x value
        (nth 0 (cdr (assoc 10 (entget (car ent)))))   ;; IP, x value
      )
    )
    (if (> inc 0.0)
      (LM:setattributevalue (car ent) tag  
        (itoa (+                                      
          (atoi (LM:getattributevalue (car ent) tag))  ;; value of the attribute, converted to int
          1
        ))
      )
      (LM:setattributevalue (car ent) tag  
        (itoa (-                                      
          (atoi (LM:getattributevalue (car ent) tag))  ;; value of the attribute, converted to int
          1
        ))
      )
    )
  )
  (princ)
)

inc_dec_attr.dwg

[AbdRF]

Thank you very much. But there are multiple blocks with a different tag. I want to make them work for all the block.May be if possible that we can choose block Name and Tag to which this lisp can be applied?

Below attached is the sample. Any help will be appreciated.Thanks

 

incsample.dwg

[Emmanuel Delay]

Sure.

 

I will assume there is only 1 attribute per block.  But it doesn't matter what the tag is now.

 

;; Get Attribute Values  -  Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [ent] Block (Insert) Entity Name
;; Returns: [lst] Association list of ((<tag> . <value>) ... )
(defun LM:getattributevalues ( blk / enx lst )
    (while (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (setq lst
            (cons
                (cons
                    (cdr (assoc 2 enx))
                    (cdr (assoc 1 (reverse enx)))
                )
                lst
            )
        )
    )
    (reverse lst)
)

;; Set Attribute Values  -  Lee Mac
;; Sets attributes with tags found in the association list to their associated values.
;; blk - [ent] Block (Insert) Entity Name
;; lst - [lst] Association list of ((<tag> . <value>) ... )
;; Returns: nil
(defun LM:setattributevalues ( blk lst / enx itm )
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (if (setq itm (assoc (cdr (assoc 2 enx)) lst))
            (progn
                (if (entmod (subst (cons 1 (cdr itm)) (assoc 1 (reverse enx)) enx))
                    (entupd blk)
                )
                (LM:setattributevalues blk lst)
            )
            (LM:setattributevalues blk lst)
        )
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Increment Decrement Attribute
(defun c:ida ( / tag ent pp inc attr val)
  (while (setq ent (entsel "\nClick right of the circle/block to increment, left to decrement: "))
    (setq pp (cadr ent))
    (setq inc
      (-  
        (nth 0 pp)                                    ;; pick point, x value
        (nth 0 (cdr (assoc 10 (entget (car ent)))))   ;; IP, x value
      )
    )
    ;; read the attributes; I only expect 1
    (setq attr (LM:getattributevalues (car ent)))
    (setq tag (nth 0 (nth 0 attr)))
    (setq val (atoi (cdr (assoc tag attr))))
    (if (> inc 0.0)
      (LM:setattributevalues (car ent) (list (cons tag (itoa (+ val 1)))))
      (LM:setattributevalues (car ent) (list (cons tag (itoa (- val 1)))))
    )
  )
  (princ)
)

[BIGAL]

A shorter version with a + - dcl

 

The pt num bubble may be usefull does circles and squares A B C 1 2 3 etc

 

; Add or subtract a number from the 1st attributes
; BY alan H April 2019

(defun c:ahadd1 ( / obj txt txtr atts)
(setq obj (vlax-ename->vla-object (car (entsel "Pick block"))))
(if (/= (setq atts (vlax-invoke obj "getattributes")) nil)
(progn
(setq txt (vla-get-textstring (nth 0 atts)))
(setq txtr (atof txt))
(if (not AH:Butts)(load "Multi radio buttons.lsp"))
(if (= but nil)(setq but 1)) ; this is needed to set default button
(setq ans (ah:butts but "V"   '("Add or subtract" "+" "-"))) 
(if (= ans "+") 
(setq txtr (+ txtr 1))
(setq txtr (- txtr 1))
)
(vla-put-textstring (nth 0 atts) (rtos txtr 2 0))
)
(alert "Block has no attributes try again")
)
(princ)
)
(c:ahadd1)

Multi radio buttons.lsp Pt num bubble.lsp

[AbdRF]

Emmanuel Delay , I am getting this error while executing lisp,
"Click right of the circle/block to increment, left to decrement: ; error: no function definition: CONS\"
Please guide me where I am going wrong.
Thanks.

[AbdRF]

HI BIGAL,
Thanks for your effort. But when I tried to run your Lisp I am getting this error
"; error: LOAD failed: "Multi Getvals.lsp"
Although when I run the c:  Ahadd1,  two radio button dialog box appears (add and subtract) but it does not allow to continuous increment or decrement value.

Thanks.

[BIGAL]

You need to save the multi lisps to a directory that is in your search path.I have a directory of all my lisps. 

 

CONFIG

Files

Support path

 

I just tested on a simple single attribute block, if your block has more than one attribute may be a problem. Post a dwg with your block

Edited April 6, 2019 by BIGAL

[AbdRF]

@Emmanuel Delay
Sorry, it was some mistake from my side, now it's working absolutely fine.
Much thanks for your help and effort.
 

[AbdRF]

@BIGAL
Thank you for your effort and time brother.

[BIGAL]

No worries