Topic: insert value into attribute

[Pad]

Hello

I wish to insert a stored variable (which happens to be text) into an attributed block, the attribute tag is 'height'.
I also wish to add a prefix of 'H: ' to the stored variable.

I can do the second bit by:
(SETQ HT1 (STRCAT "H: " HT))

this is the lisp I have at the moment.

The block has 7 attributes and the height attribute is the 6th.

A quick hand with this would be appreciated.

I need to change this part:
(COMMAND "text" PTXT THGT "<<0" HT2)
(command "move" "last" "" PTXT pause)

so that 'HT2' is inserted into the attributed block

Code: [Select]

;;
;;
(defun C:TH()
;;


(setq ent1 (car (entsel "\nPick the Tree Level:"))); single pick
(setq ent4 (car (entsel "\nPick the Height Level:"))); single pick

(if ent1
(progn
(setq elist1 (entget ent1)); get a List of that entity
(setq atr1 (entnext ent1)); get 1st attribute entity
(setq en1 (entget atr1)); get a List of attribute entity
(setq val1 (cdr (assoc 1 en1))); get the attrib's value
(setq num1 (atof val1)); make a number of val

(if ent4
(progn
(setq elist4 (entget ent4)); get a List of that entity
(setq atr4 (entnext ent4)); get 1st attribute entity
(setq en4 (entget atr4)); get a List of attribute entity
(setq val4 (cdr (assoc 1 en4))); get the attrib's value
(setq num4 (atof val4)); make a number of val



   (prompt (strcat "\nTREE LEVEL=" val1)); display on Command Line
   (prompt (strcat "\nHEIGHT LEVEL=" val4)); display on Command Line


(SETVAR "cmdecho" 0)

(COMMAND "units" "" 2 "" "" "" "")

  (setq HT (rtos (- num4 num1)))

(COMMAND "units" "" 3 "" "" "" "")

(SETVAR "cmdecho" 1)

   (prompt (strcat "\nTREE HEIGHT=" HT)); display on Command Line


 ); progn
 ); if


(SETQ DFLT 0)
(SETQ TXTHG (GETVAR "textsize"))
(PRINC "\nText Height: <")
(PRIN1 TXTHG)
(PRINC ">: ")
(SETQ THGT (GETDIST))
(IF (= THGT nil)
(SETQ THGT TXTHG)
)


;(SETQ ANNOT (GETSTRING "\nAnnotation: "))

(SETQ HT1 (STRCAT "H: " HT))
(SETQ HT2 (STRCASE HT1))


;;(SETQ PTXT (GETPOINT "\nLocate Text: "))

(setq old_layer (getvar "clayer")); Get current Layer

(SETVAR "cmdecho" 0)

(setq PTXT (getvar "viewctr"))

(COMMAND "layer" "se" "tree text" "")

;(COMMAND "text" PTXT THGT "<<0" HT2)
;(command "move" "last" "" PTXT pause)


(setq CLASHING "CLASHING_LEVELS")


(if (not (tblsearch "layer" CLASHING))
(command "_layer" "M" CLASHING ""); Make the Layer, and set it current
); if

(command "_change" ent4 "" "_P" "_LA" CLASHING "")

(command "_layer" "S" old_layer ""); reset Layer

(SETVAR "cmdecho" 1)

 (princ)
))); function LEV2HT
cheers
P

[CAB]

Are the Tag names for the attributes not constant? 
Do you know them in advance?

Can you post a sample DWG with the two blocks in it?

[CAB]

Here is a OLD example using visual lisp.

Code: [Select]

;;  Room Number Update by CAB 03/21/2005
;;  Update selected blocks with attribute "ROOM#"
;;  with user entered room number
;;  NOTE: Very little error checking
;;
;;   Modified a subroutine by Jeff Mishler 1/11/05
;;
(defun c:rm#update (/ rm# attname ss count blk atts2 att2 att1 bc)
  (vl-load-com)

  (setq rm# (getstring t "\nEnter new room number: ")
        attname "RM#"  ; uppercase only
        bc 0) ; block counter

  (prompt "\n***  Select blocks to change room number.  ***")
  ;;  get only blocks with attributes
  (if (and rm#
           (not (eq rm# ""))
           (setq ss (ssget (list '(0 . "INSERT") '(66 . 1))))
      )
    (progn
      (setq count -1)
      (while (< (setq count (1+ count)) (sslength ss))
        (setq blk   (vlax-ename->vla-object (ssname ss count))
              atts2 (vlax-invoke blk "getattributes")
        )
        (foreach att2 atts2
          (if (= attname (vla-get-tagstring att2))
            (progn
              (vla-put-textstring att2 rm#)
              (vla-update att2)
              (vla-update blk)
              (setq bc (1+ bc))
            )
          )
        )
      )
      (prompt (strcat "\n-=< " (itoa bc) " blocked updated  >=-"))
    ) ; progn
    (prompt "\n---  No blocks Updated  ---")
  ) ; endif
  (princ)
) ; defun
(prompt "\nRoom Number Update Loaded, Enter Rm#Update to run.")
(princ)

[Pad]

hi cab

thanks for your reply.

the tag is constant 'height'

attached is an example.
the tree canopies should look familiar to you 

thanks for the example, but i do struggle to understand visual lisp.  But I will give it a study.

P

[Lee Mac]

Perhaps this subfunction will help you along the way - using Vanilla:

Code: [Select]

;; block = Attributed Block Entity Name       [ENAME]
;; tag   = Tag of Attribute to set to value   [STR]
;; value = Value to which tag is set          [STR]

(defun SetAttribValue ( block tag value / el )
  (if (= 1 (cdr (assoc 66 (entget block))))
    (while
      (not
        (eq "SEQEND"
          (cdr
            (assoc 0
              (setq el
                (entget
                  (setq block (entnext block))
                )
              )
            )
          )
        )
      )
      (if (eq tag (cdr (assoc 2 el)))
        (entupd
          (cdr
            (assoc -1
              (entmod
                (subst
                  (cons 1 value) (assoc 1 el) el
                )
              )
            )
          )
        )
      )
    )
  )
)


;; Example

(defun c:test ( / en tg vl )
 
  (if (and (setq en (car (entsel "\nSelect Block: ")))
           (eq "INSERT" (cdr (assoc 0 (entget en))))
           (setq tg (getstring "\nSpecify Tag to Update: "))
           (setq vl (getstring t "\nSpecify New Value: "))
      )
    (SetAttribValue en (strcase tg) vl)
  )

  (princ)
)

I have also included an example of how to call the subfunction.

[Pad]

oh yeah, I reckon I can do something with that.
Cheers CAB!
P

[Pad]

yep got it working! brilliant stuff.

[Pad]

one other thing

at the top of the lisp i now have this:

(setq en (car (entsel "\nPick the Tree Level:"))); single pick

and I changed this bit to:
  (if (and ;(setq en (car (entsel "\nSelect Block: ")))

I would like to have the option to select the block again. ie:   (if (and (setq en (car (entsel "\nSelect Block: ")))
but only if the block originally picked is not a 'PT2' block.

Is that possible?

Ta

[Lee Mac]

oh yeah, I reckon I can do something with that.
Cheers CAB!
P

yep got it working! brilliant stuff.

I would like to have the option to select the block again. ie:   (if (and (setq en (car (entsel "\nSelect Block: ")))
but only if the block originally picked is not a 'PT2' block.

Sorry Pad, are you referring to my code or CAB's?

[Pad]

Sorry Lee.

I had a silly monent and thought your code was posted by CAB.
Your code has done the trick!
Cheers Lee 

[David Bethel]

Or maybe something I little older style wise:

Code: [Select]

  (princ "\nSelect INSERTs To Update....")
  (and (setq i -1 ss (ssget '((0 . "INSERT")(66 . 1))))
       (while (setq en (ssname ss (setq i (1+ i))))
              (setq an (entnext en)
                    ad (entget an)
                    ch nil)
              (while (= "ATTRIB" (cdr (assoc 0 ad)))
                     (and (= (strcase (cdr (assoc 2 ad))) "HEIGHT")
                          (setq ch T)
                          (entmod (subst (cons 1 ht1) (assoc 1 ad) ad)))
                     (setq an (entnext an)
                           ad (entget an)))
              (if ch (entupd en))))


[Lee Mac]

Sorry Lee.

I had a silly monent and thought your code was posted by CAB.
Your code has done the trick!

Not a problem

To answer your question, perhaps you could use a construct similar to this:

Code: [Select]

(defun c:test ( / en )
  (while
    (progn
      (if (setq en (car (entsel "\nSelect Block: ")))
       
        (if (and (eq "INSERT" (cdr (assoc 0 (entget en))))
                 (= 1 (cdr (assoc 66 (entget en))))
                 (eq "PT2" (strcase (cdr (assoc 2 (entget en)))))
            )

          (SetAttribValue en
            (strcase (getstring "\nSpecify Tag: "))
            (getstring t "\nSpecify New Value: ")
          )

          (princ "\n** Please Select a PT2 Block! **")
        )
      )
    )
  )

  (princ)
)
I'm sure it could be coded in a number of ways 

[Pad]

thanks.
I'll give that a go.

[snownut2]

Perhaps this subfunction will help you along the way - using Vanilla:

Code: [Select]

;; block = Attributed Block Entity Name       [ENAME]
;; tag   = Tag of Attribute to set to value   [STR]
;; value = Value to which tag is set          [STR]

(defun SetAttribValue ( block tag value / el )
  (if (= 1 (cdr (assoc 66 (entget block))))
    (while
      (not
        (eq "SEQEND"
          (cdr
            (assoc 0
              (setq el
                (entget
                  (setq block (entnext block))
                )
              )
            )
          )
        )
      )
      (if (eq tag (cdr (assoc 2 el)))
        (entupd
          (cdr
            (assoc -1
              (entmod
                (subst
                  (cons 1 value) (assoc 1 el) el
                )
              )
            )
          )
        )
      )
    )
  )
)


;; Example

(defun c:test ( / en tg vl )
 
  (if (and (setq en (car (entsel "\nSelect Block: ")))
           (eq "INSERT" (cdr (assoc 0 (entget en))))
           (setq tg (getstring "\nSpecify Tag to Update: "))
           (setq vl (getstring t "\nSpecify New Value: "))
      )
    (SetAttribValue en (strcase tg) vl)
  )

  (princ)
)

I have also included an example of how to call the subfunction.

Lee,

I would like to not have to select the block, but to indicate it programmatically.  Have not had much success in that regard.

Bruce

[Lee Mac]

I would like to not have to select the block, but to indicate it programmatically.  Have not had much success in that regard.

Without knowing the entity handle of the block reference (for use with handent / vla-handletoobject), you would need to use an automated selection method such as using the ssget function with either the _W / _C / _WP / _CP / _X etc. mode strings, or the nentselp function with a given point argument.