Rotate all attributes with a specific tag.

JULY 28, 2009

BELOW IS THE COMPLETED REVISED CODE.

THIS CODE WILL PROMPT FOR ROTATION ANGLE.

CODE ALSO HAS ERROR TRAPPING AS WELL.

TO USE THIS PROGRAM FOR YOUR OWN BLOCKS WITH

ATTRIBUTES REFER TO THE SECTION OF CODE HIGHLIGHTED IN RED.

YOU CAN CHANGE THE ATTRIBUTE TAG HERE IN THE CODE

TO BE USED WITH YOUR OWN ATTRIBUTE TAGS.

SEE BELOW FOR ATTACHED Line_Extension.dwg TO TEST PROGRAM.

FUNCTION SYNTAX FOR THIS CODE: AVR

Line_Extension.dwg

AVR.zip

Hello again,

 

I wrote this routine to rotate all attributes with a specific attribute tag. It seems to only rotate the attribute of the last object inserted. Any direction on this would be appreciated. I have attached the drawing in 2000 format and display the code below.

 

Thanks in advance.

The Buzzard

 

(defun C:TVR ()
 (setq BNAM "8-WAY")
 (setq LNAM "T-TAPP-IDEN")
 (setq BLOCROT (ssget "x" (list (cons 0 "INSERT")(cons 2 BNAM)(cons 8 LNAM)(cons 66 1))))
 (if
   (/= BLOCROT nil)
   (progn
     (setq INDEX 0)
     (sslength BLOCROT)
     (setq ENAME (ssname BLOCROT INDEX))
     (setq ELIST (entget ENAME))
     (while
       (/= (cdr (assoc 0 ELIST)) "SEQEND")
       (setq ELIST (entget ENAME))
       (if 
         (= "TAP-VAL" (cdr (assoc 2 ELIST)))
         (progn
           (entmod
             (subst
               (cons 50 0.0)
               (assoc 50 ELIST) ELIST
             )
           )
           (entupd ENAME)
         )
       )
       (setq ENAME (entnext ENAME))
     )
   )
   (ALERT (strcat "\nThe block "BNAM" was not found."))
 )
 (princ)
)

Thanks anyway, I got it!

(defun C:TVR ()
 (setq BNAM "8-WAY")
 (setq BLOCROT (ssget "x" (list (cons 0 "INSERT")(cons 2 BNAM)(cons 66 1))))
 (if
   (/= BLOCROT nil)
   (progn
     (setq INDEX 0)
     (repeat
       (sslength BLOCROT)
       (setq ENAME (ssname BLOCROT INDEX))
       (setq ELIST (entget ENAME))
       (while
         (/= (cdr (assoc 0 ELIST)) "SEQEND")
         (setq ELIST (entget ENAME))
         (if 
           (= "TAP-VAL" (cdr (assoc 2 ELIST)))
           (progn
             (entmod
               (subst
                 (cons 50 0.0)
                 (assoc 50 ELIST) ELIST
               )
             )
             (entupd ENAME)
           )
         )
         (setq ENAME (entnext ENAME))
       )
       (setq INDEX (1+ INDEX))
     )
   )
   (ALERT (strcat "\nThe block "BNAM" was not found."))
 )
 (princ)
)

Wow.. I wrote something to do just what you seem to be asking, and the funny part is, I'm using it at the moment

Not sure if this completely solves the problem, but here's my function:

(defun c:cr( / ss obj)
 (vl-load-com)
 (if (ssget "X" (list (cons 2 "IDI-SECU-CAMR")))
   (progn
     (vlax-for obj (setq ss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
   (if (= (vla-get-HasAttributes obj) :vlax-true)
     (foreach attVar (vlax-invoke obj 'GetAttributes)
       (if (not (= (vla-get-TagString attVar) "NUM"))
         (vla-put-Rotation attVar 0)))))
     (vla-delete ss)))
 (princ)
 )

Pretty straightforward: get all blocks of a certain name, then go through each of the attributes of the block and see which one is labeled "NUM", and set the rotation equal to 0 (the vla-put-rotation part). I wrote this because I have a lot of blocks with various rotations, and I wanted to put the attributes of all those blocks back to a rotation of 0 degrees for readability.

Hope that helps somewhat. ^.^

Wow.. I wrote something to do just what you seem to be asking, and the funny part is, I'm using it at the moment

 

Not sure if this completely solves the problem, but here's my function:

 

(defun c:cr( / ss obj)
 (vl-load-com)
 (if (ssget "X" (list (cons 2 "IDI-SECU-CAMR")))
   (progn
     (vlax-for obj (setq ss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
   (if (= (vla-get-HasAttributes obj) :vlax-true)
     (foreach attVar (vlax-invoke obj 'GetAttributes)
       (if (not (= (vla-get-TagString attVar) "NUM"))
         (vla-put-Rotation attVar 0)))))
     (vla-delete ss)))
 (princ)
 )

 

Pretty straightforward: get all blocks of a certain name, then go through each of the attributes of the block and see which one is labeled "NUM", and set the rotation equal to 0 (the vla-put-rotation part). I wrote this because I have a lot of blocks with various rotations, and I wanted to put the attributes of all those blocks back to a rotation of 0 degrees for readability.

 

Hope that helps somewhat. ^.^

Thanks Freerefill,

But on the previous post I figured it out last minute. I appreciate the code, But I was only looking for some direction. I just needed to get my code working. I want to learn this stuff and not depend on others to do it for me. Trust me when I tell you the efforts and code are very much appreciated. I knew I was so close to figuring it out, But then you just get those moments where your brain seems washed out.

Thanks,

The Buzzard

Another quick method:

;; ============[ AttRot.lsp ]===============
;;
;;  FUNCTION:
;;  Will move Multiple Attribute Tags
;;
;;  SYNTAX: ATTROT
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;  VERSION:
;;  1.0  ~  02.07.2009
;;
;; =========================================

(defun c:AttRot (/ *error* lklst ent Blk
                  Obj bNme ss bPt ObjLst
                  iPt gr dat cAng)
 
 (vl-load-com)

 (defun *error* (msg)
   (vla-EndUndoMark
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
   (if lklst
     (foreach l lklst
       (vla-put-lock
         (car l) (cdr l))))
   (if (not
         (wcmatch
           (strcase msg)
             "*BREAK,*CANCEL*,*EXIT*"))
     (princ
       (strcat "\n<< Error: " msg " >>")))
   (redraw)
   (princ))
           

 (vlax-for l
   (vla-get-layers
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
   (setq lklst
     (cons
       (cons l
         (vla-get-lock l)) lklst))
   (vla-put-lock l :vlax-false))

 (while
   (progn
     (setq ent
       (car (nentsel "\nSelect Attribute: ")))
     (cond
       ((eq 'ENAME (type ent))
        (if
          (not
            (eq "ATTRIB"
                (cdr (assoc 0 (entget ent)))))
          (princ "\n** Object is not an Attribute **")
          nil))
       (t (princ "\n** Nothing Selected **")))))

 (setq Blk
   (vla-ObjectIdtoObject
     (vla-get-ActiveDocument
       (vlax-get-acad-object))
     (vla-get-OwnerId
       (setq Obj
         (vlax-ename->vla-object ent)))))

 (setq bNme
   (if (vlax-property-available-p Blk 'EffectiveName)
     (vla-get-EffectiveName Blk)
       (vla-get-Name Blk)))

 (setq ss
   (ssget "_X" (list (cons 0 "INSERT")
                       (cons 2 bNme)
                         (cons 66 1))))

 (vla-StartUndoMark
   (vla-get-ActiveDocument
     (vlax-get-acad-object)))

 (setq ObjLst
   (vl-remove-if-not
     (function
       (lambda (x)
         (eq (vla-get-TagString x)
               (vla-get-TagString Obj))))
     (apply 'append
       (mapcar 'asmi-GetAttributes
         (mapcar 'vlax-ename->vla-object
           (mapcar 'cadr (ssnamex ss)))))))

 (setq iPt
   (vlax-safearray->list
     (vlax-variant-value
       (vla-get-TextAlignmentPoint Obj))))        

 (while
   (progn
     (setq gr (grread t 15 0) dat (cadr gr))
     (cond
       ((and (eq 5 (car gr)) (listp dat))
        (redraw)
        (setq cAng
          (angle
            (vlax-safearray->list
              (vlax-variant-value
                (vla-get-TextAlignmentPoint Obj))) dat))
        (mapcar
          (function
            (lambda (x)
              (vla-put-rotation x cAng))) ObjLst)
        (grvecs (list -6 iPt dat)) t) ; Keep in Loop
       ((or (eq 25 (car gr)) ; Right Click
            (eq 3 (car gr)) ; Left Click
            (and
              (eq 2 (car gr))
              (vl-position dat '(13 32)))) ; Enter Space
        nil) ; Exit Loop
       )))       
        

 (vla-EndUndoMark
   (vla-get-ActiveDocument
     (vlax-get-acad-object)))
 
 (foreach l lklst
   (vla-put-lock
     (car l) (cdr l)))

 (redraw)
 (princ))

;; ASMI
(defun asmi-GetAttributes (Block / atArr caArr)
  (append
    (if
      (not
        (vl-catch-all-error-p
          (setq atArr
            (vl-catch-all-apply
              'vlax-safearray->list
            (list
              (vlax-variant-value
                (vla-GetAttributes Block)))))))
          atArr)
    (if
      (not
        (vl-catch-all-error-p
          (setq caArr
            (vl-catch-all-apply
              'vlax-safearray->list
            (list
              (vlax-variant-value
                (vla-GetConstantAttributes Block)))))))
            caArr)))  

Another quick method:

 

;; ============[ AttRot.lsp ]===============
;;
;;  FUNCTION:
;;  Will move Multiple Attribute Tags
;;
;;  SYNTAX: ATTROT
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;  VERSION:
;;  1.0  ~  02.07.2009
;;
;; =========================================

(defun c:AttRot (/ *error* lklst ent Blk
                  Obj bNme ss bPt ObjLst
                  iPt gr dat cAng)

 (vl-load-com)

 (defun *error* (msg)
   (vla-EndUndoMark
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
   (if lklst
     (foreach l lklst
       (vla-put-lock
         (car l) (cdr l))))
   (if (not
         (wcmatch
           (strcase msg)
             "*BREAK,*CANCEL*,*EXIT*"))
     (princ
       (strcat "\n<< Error: " msg " >>")))
   (redraw)
   (princ))


 (vlax-for l
   (vla-get-layers
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
   (setq lklst
     (cons
       (cons l
         (vla-get-lock l)) lklst))
   (vla-put-lock l :vlax-false))

 (while
   (progn
     (setq ent
       (car (nentsel "\nSelect Attribute: ")))
     (cond
       ((eq 'ENAME (type ent))
        (if
          (not
            (eq "ATTRIB"
                (cdr (assoc 0 (entget ent)))))
          (princ "\n** Object is not an Attribute **")
          nil))
       (t (princ "\n** Nothing Selected **")))))

 (setq Blk
   (vla-ObjectIdtoObject
     (vla-get-ActiveDocument
       (vlax-get-acad-object))
     (vla-get-OwnerId
       (setq Obj
         (vlax-ename->vla-object ent)))))

 (setq bNme
   (if (vlax-property-available-p Blk 'EffectiveName)
     (vla-get-EffectiveName Blk)
       (vla-get-Name Blk)))

 (setq ss
   (ssget "_X" (list (cons 0 "INSERT")
                       (cons 2 bNme)
                         (cons 66 1))))

 (vla-StartUndoMark
   (vla-get-ActiveDocument
     (vlax-get-acad-object)))

 (setq ObjLst
   (vl-remove-if-not
     (function
       (lambda (x)
         (eq (vla-get-TagString x)
               (vla-get-TagString Obj))))
     (apply 'append
       (mapcar 'asmi-GetAttributes
         (mapcar 'vlax-ename->vla-object
           (mapcar 'cadr (ssnamex ss)))))))

 (setq iPt
   (vlax-safearray->list
     (vlax-variant-value
       (vla-get-TextAlignmentPoint Obj))))        

 (while
   (progn
     (setq gr (grread t 15 0) dat (cadr gr))
     (cond
       ((and (eq 5 (car gr)) (listp dat))
        (redraw)
        (setq cAng
          (angle
            (vlax-safearray->list
              (vlax-variant-value
                (vla-get-TextAlignmentPoint Obj))) dat))
        (mapcar
          (function
            (lambda (x)
              (vla-put-rotation x cAng))) ObjLst)
        (grvecs (list -6 iPt dat)) t) ; Keep in Loop
       ((or (eq 25 (car gr)) ; Right Click
            (eq 3 (car gr)) ; Left Click
            (and
              (eq 2 (car gr))
              (vl-position dat '(13 32)))) ; Enter Space
        nil) ; Exit Loop
       )))       


 (vla-EndUndoMark
   (vla-get-ActiveDocument
     (vlax-get-acad-object)))

 (foreach l lklst
   (vla-put-lock
     (car l) (cdr l)))

 (redraw)
 (princ))

;; ASMI
(defun asmi-GetAttributes (Block / atArr caArr)
  (append
    (if
      (not
        (vl-catch-all-error-p
          (setq atArr
            (vl-catch-all-apply
              'vlax-safearray->list
            (list
              (vlax-variant-value
                (vla-GetAttributes Block)))))))
          atArr)
    (if
      (not
        (vl-catch-all-error-p
          (setq caArr
            (vl-catch-all-apply
              'vlax-safearray->list
            (list
              (vlax-variant-value
                (vla-GetConstantAttributes Block)))))))
            caArr)))  

Thanks Lee,

My brain jump started the last minute. See post 2.

Its very much appreciated, But as you know I do not want code done for me. I need to figure it out independently. Pointing me in the right

direction would be good enough.

Thank You,

The Buzzard

Thanks Lee,

 

My brain jump started the last minute. See post 2.

Its very much appreciated, But as you know I do not want code done for me. I need to figure it out independently. Pointing me in the right

direction would be good enough.

 

Thank You,

The Buzzard

Ok, but just for kicks - this one will let you enter the angle also

;; ============[ AttRot.lsp ]===============
;;
;;  FUNCTION:
;;  Will move Multiple Attribute Tags
;;
;;  SYNTAX: ATTROT
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;  VERSION:
;;  1.0  ~  02.07.2009
;;  2.0  ~  02.07.2009
;;
;; =========================================

(defun c:AttRot (/ *error* lklst ent Blk
                  Obj bNme ss bPt ObjLst
                  iPt gr dat cAng vl ov str)
 
 (vl-load-com)

 (defun *error* (msg)
   (vla-EndUndoMark
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
   (if ov (mapcar 'setvar vl ov))
   (if lklst
     (foreach l lklst
       (vla-put-lock
         (car l) (cdr l))))
   (if (not
         (wcmatch
           (strcase msg)
             "*BREAK,*CANCEL*,*EXIT*"))
     (princ
       (strcat "\n<< Error: " msg " >>")))
   (redraw)
   (princ))

 (setq vl '("MODEMACRO")
       ov (mapcar 'getvar vl))           

 (vlax-for l
   (vla-get-layers
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
   (setq lklst
     (cons
       (cons l
         (vla-get-lock l)) lklst))
   (vla-put-lock l :vlax-false))

 (while
   (progn
     (setq ent
       (car (nentsel "\nSelect Attribute: ")))
     (cond
       ((eq 'ENAME (type ent))
        (if
          (not
            (eq "ATTRIB"
                (cdr (assoc 0 (entget ent)))))
          (princ "\n** Object is not an Attribute **")
          nil))
       (t (princ "\n** Nothing Selected **")))))

 (setq Blk
   (vla-ObjectIdtoObject
     (vla-get-ActiveDocument
       (vlax-get-acad-object))
     (vla-get-OwnerId
       (setq Obj
         (vlax-ename->vla-object ent)))))

 (setq bNme
   (if (vlax-property-available-p Blk 'EffectiveName)
     (vla-get-EffectiveName Blk)
       (vla-get-Name Blk)))

 (setq ss
   (ssget "_X" (list (cons 0 "INSERT")
                       (cons 2 bNme)
                         (cons 66 1))))

 (vla-StartUndoMark
   (vla-get-ActiveDocument
     (vlax-get-acad-object)))

 (setq ObjLst
   (vl-remove-if-not
     (function
       (lambda (x)
         (eq (vla-get-TagString x)
               (vla-get-TagString Obj))))
     (apply 'append
       (mapcar 'asmi-GetAttributes
         (mapcar 'vlax-ename->vla-object
           (mapcar 'cadr (ssnamex ss)))))))

 (setq iPt
   (vlax-safearray->list
     (vlax-variant-value
       (vla-get-TextAlignmentPoint Obj))) str "")       

 (while
   (progn
     (setq gr (grread t 15 0) dat (cadr gr))
     (setvar "MODEMACRO"
       (strcat "Rotation: "
         (rtos (rtd (vla-get-Rotation Obj)) 2 2) (chr 186)))
     (cond
       ((and (eq 5 (car gr)) (listp dat))
        (redraw)
        (setq cAng
          (angle
            (vlax-safearray->list
              (vlax-variant-value
                (vla-get-TextAlignmentPoint Obj))) dat))
        (mapcar
          (function
            (lambda (x)
              (vla-put-rotation x cAng))) ObjLst)
        (grvecs (list -6 iPt dat)) t) ; Keep in Loop
       ((eq 2 (car gr))
        (cond ((or (eq 46 dat) (<= 48 dat 57)) ; numbers or dp.
               (princ (chr dat))
               (setq str (strcat str (chr dat))))
              ((eq 8 dat) ; BackSpace
               (princ (strcat (chr  (chr 32) (chr ))
               (setq str (substr str 1 (1- (strlen str)))))
              ((vl-position dat '(32 13)) ; Enter Space
               (if (setq cAng (distof str))
                 (not ; Exit Loop
                   (mapcar
                     (function
                       (lambda (x)
                         (vla-put-rotation x (dtr cAng)))) Objlst))
                 nil)) ; Exit Loop
              (t t))) ; Keep in Loop
       ((or (eq 25 (car gr)) ; Right Click
            (eq 3 (car gr))) ; Left Click
        nil) ; Exit Loop
       (t t)))) ; Keep in Loop
 
 (vla-EndUndoMark
   (vla-get-ActiveDocument
     (vlax-get-acad-object)))
 
 (foreach l lklst
   (vla-put-lock
     (car l) (cdr l)))

 (mapcar 'setvar vl ov)
 (redraw)
 (princ))

(defun rtd (x)
 (* 180. (/ x pi)))

(defun dtr (x)
 (* pi (/ x 180.)))

;; ASMI
(defun asmi-GetAttributes (Block / atArr caArr)
  (append
    (if
      (not
        (vl-catch-all-error-p
          (setq atArr
            (vl-catch-all-apply
              'vlax-safearray->list
            (list
              (vlax-variant-value
                (vla-GetAttributes Block)))))))
          atArr)
    (if
      (not
        (vl-catch-all-error-p
          (setq caArr
            (vl-catch-all-apply
              'vlax-safearray->list
            (list
              (vlax-variant-value
                (vla-GetConstantAttributes Block)))))))
            caArr)))  

Ok, but just for kicks - this one will let you enter the angle also

 

;; ============[ AttRot.lsp ]===============
;;
;;  FUNCTION:
;;  Will move Multiple Attribute Tags
;;
;;  SYNTAX: ATTROT
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;  VERSION:
;;  1.0  ~  02.07.2009
;;  2.0  ~  02.07.2009
;;
;; =========================================

(defun c:AttRot (/ *error* lklst ent Blk
                  Obj bNme ss bPt ObjLst
                  iPt gr dat cAng vl ov str)

 (vl-load-com)

 (defun *error* (msg)
   (vla-EndUndoMark
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
   (if ov (mapcar 'setvar vl ov))
   (if lklst
     (foreach l lklst
       (vla-put-lock
         (car l) (cdr l))))
   (if (not
         (wcmatch
           (strcase msg)
             "*BREAK,*CANCEL*,*EXIT*"))
     (princ
       (strcat "\n<< Error: " msg " >>")))
   (redraw)
   (princ))

 (setq vl '("MODEMACRO")
       ov (mapcar 'getvar vl))           

 (vlax-for l
   (vla-get-layers
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
   (setq lklst
     (cons
       (cons l
         (vla-get-lock l)) lklst))
   (vla-put-lock l :vlax-false))

 (while
   (progn
     (setq ent
       (car (nentsel "\nSelect Attribute: ")))
     (cond
       ((eq 'ENAME (type ent))
        (if
          (not
            (eq "ATTRIB"
                (cdr (assoc 0 (entget ent)))))
          (princ "\n** Object is not an Attribute **")
          nil))
       (t (princ "\n** Nothing Selected **")))))

 (setq Blk
   (vla-ObjectIdtoObject
     (vla-get-ActiveDocument
       (vlax-get-acad-object))
     (vla-get-OwnerId
       (setq Obj
         (vlax-ename->vla-object ent)))))

 (setq bNme
   (if (vlax-property-available-p Blk 'EffectiveName)
     (vla-get-EffectiveName Blk)
       (vla-get-Name Blk)))

 (setq ss
   (ssget "_X" (list (cons 0 "INSERT")
                       (cons 2 bNme)
                         (cons 66 1))))

 (vla-StartUndoMark
   (vla-get-ActiveDocument
     (vlax-get-acad-object)))

 (setq ObjLst
   (vl-remove-if-not
     (function
       (lambda (x)
         (eq (vla-get-TagString x)
               (vla-get-TagString Obj))))
     (apply 'append
       (mapcar 'asmi-GetAttributes
         (mapcar 'vlax-ename->vla-object
           (mapcar 'cadr (ssnamex ss)))))))

 (setq iPt
   (vlax-safearray->list
     (vlax-variant-value
       (vla-get-TextAlignmentPoint Obj))) str "")       

 (while
   (progn
     (setq gr (grread t 15 0) dat (cadr gr))
     (setvar "MODEMACRO"
       (strcat "Rotation: "
         (rtos (rtd (vla-get-Rotation Obj)) 2 2) (chr 186)))
     (cond
       ((and (eq 5 (car gr)) (listp dat))
        (redraw)
        (setq cAng
          (angle
            (vlax-safearray->list
              (vlax-variant-value
                (vla-get-TextAlignmentPoint Obj))) dat))
        (mapcar
          (function
            (lambda (x)
              (vla-put-rotation x cAng))) ObjLst)
        (grvecs (list -6 iPt dat)) t) ; Keep in Loop
       ((eq 2 (car gr))
        (cond ((or (eq 46 dat) (<= 48 dat 57)) ; numbers or dp.
               (princ (chr dat))
               (setq str (strcat str (chr dat))))
              ((eq 8 dat) ; BackSpace
               (princ (strcat (chr  (chr 32) (chr ))
               (setq str (substr str 1 (1- (strlen str)))))
              ((vl-position dat '(32 13)) ; Enter Space
               (if (setq cAng (distof str))
                 (not ; Exit Loop
                   (mapcar
                     (function
                       (lambda (x)
                         (vla-put-rotation x (dtr cAng)))) Objlst))
                 nil)) ; Exit Loop
              (t t))) ; Keep in Loop
       ((or (eq 25 (car gr)) ; Right Click
            (eq 3 (car gr))) ; Left Click
        nil) ; Exit Loop
       (t t)))) ; Keep in Loop

 (vla-EndUndoMark
   (vla-get-ActiveDocument
     (vlax-get-acad-object)))

 (foreach l lklst
   (vla-put-lock
     (car l) (cdr l)))

 (mapcar 'setvar vl ov)
 (redraw)
 (princ))

(defun rtd (x)
 (* 180. (/ x pi)))

(defun dtr (x)
 (* pi (/ x 180.)))

;; ASMI
(defun asmi-GetAttributes (Block / atArr caArr)
  (append
    (if
      (not
        (vl-catch-all-error-p
          (setq atArr
            (vl-catch-all-apply
              'vlax-safearray->list
            (list
              (vlax-variant-value
                (vla-GetAttributes Block)))))))
          atArr)
    (if
      (not
        (vl-catch-all-error-p
          (setq caArr
            (vl-catch-all-apply
              'vlax-safearray->list
            (list
              (vlax-variant-value
                (vla-GetConstantAttributes Block)))))))
            caArr)))  

That's pretty novel, But I only needed to set the angle to zero no matter what angle the block is. I may use this routine later in several different ways. As for now I am glad I got past this one myself. I may be adding it to those block library programs the I like to create.

I will get to VL in time, But only after I grasp vanilla first.

Thanks

That's pretty novel, But I only needed to set the angle to zero no matter what angle the block is. I may use this routine later in several different ways. As for now I am glad I got past this one myself. I may be adding it to those block library programs the I like to create.

I will get to VL in time, But only after I grasp vanilla first.

 

Thanks

I understand completely, this has inspired me to create some kind of Attribute Suite... maybe coming later

I understand completely, this has inspired me to create some kind of Attribute Suite... maybe coming later

Sounds great. I cannot help but notice that attribute manipulation and value editing are very popular tasks that are always mentioned. I am sure you will get alot of hits for those programs as they are always in demand.

Looking forward to it Lee,

Thanks,

The Buzzard

Notice to ALL,

The code has been revised and posted to the first post of this thread. All details of the changes plus a sample drawing saved to 2000 format has been provided for you to test the code.

Enjoy the program,

The Buzzard

Buzzard, I advise you take a look at the highlighted section in your code, you have a slight error

;///////////////////////////////////////////////////////////////////////
;///////////////////////////////////////////////////////////////////////
;///                                                                 ///
;/// Program: Attribute Value Rotate Lisp - AVR.lsp                  ///
;/// Date:    July 03, 2009                                          ///
;/// Author:  Angelo M. Bozzone aka The Buzzard                      ///
;/// Contact: The Buzzard at [url]http://www.cadtutor.net/forum/index.php[/url] ///
;///                                                                 ///
;/// Program Description: Globally rotates block attributes with a   ///
;///                      specified tag by specifying an angle.      ///
;///                                                                 ///
;/// Program Features:                                               ///
;///                                                                 ///
;/// 1. Program has variable save, restore and error trapping.       ///
;/// 2. Saves last entered attribute rotation angle for drawing      ///
;///    session.                                                     ///
;///                                                                 ///
;///                                                                 ///
;/// Function Syntax: AVR                                            ///
;///                                                                 ///
;///////////////////////////////////////////////////////////////////////
;///////////////////////////////////////////////////////////////////////
; Main Function - Attribute Value Rotate.
(defun C:AVR (/ ATROT INDEX ENAME ELIST SUCE SUAB SUAD)                 ;Define function, Declare local variables
 (setq SUCE (getvar "cmdecho"))                                        ;Save user cmdecho
 (setq SUAB (getvar "angbase"))                                        ;Save user angbase
 (setq SUAD (getvar "angdir"))                                         ;Save user angdir
 (setq temperr *error*)                                                ;Save error in variable temperr
 (setq *error* AVR_ET)                                                 ;When error occurs goto Start Error Trap Function
 (setvar "cmdecho"  0)                                                 ;Turn off cmdecho
 (setvar "angbase"  0.000)                                             ;Set variable angbase to 0 with respect to the current UCS
 (setvar "angdir"   0)                                                 ;Set variable angdir  to 0 Counterclockwise direction
 (or   A:ANG# (setq A:ANG# 0.0))                                       ;Set default attribute angle ~ (real)
[b][color=Red]  (setq A:ANG$ (rtos A:ANG# 2 1))                                       ;Convert A:ANG# ~ (real) to A:ANG$ ~ (string) (setq A:ANG#                                                          ;Set attribute angle ~ (real)
   (cond                                                               ;Conditional
     ((getreal (strcat "\nSpecify attribute angle < "A:ANG$" >:")))    ;Concatenate string, Get attribute angle, Display default ~ (string)
     (T (setq A:ANG# A:ANG#))                                          ;Attribute angle default ~ (real)
   )                                                                   ;End cond
 ) [/color][/b]                                                                    ;End setq
 (setq ATROT                                                           ;Set attribute rotation
   (ssget "_x"                                                         ;Creates a selection set from the selected objects
     (list                                                             ;Start list
       (cons 0 "INSERT")                                               ;Filter for insertion
       (cons 66 1)                                                     ;Filter for attribute
     )                                                                 ;End list
   )                                                                   ;End selection set
 )                                                                     ;End setq

 (if                                                                   ;If the following returns true
   (/= ATROT nil)                                                      ;Selected blocks are not found
   (progn                                                              ;Then do the following
     (setq INDEX 0)                                                    ;Set INDEX to 0
     (repeat                                                           ;Evaluate expression a specified number of times and return the last
       (sslength ATROT)                                                ;Return number of entities in the selection set
       (setq ENAME (ssname ATROT INDEX))                               ;Return the entity name of the indexed element of the selection set 
       (setq ELIST (entget ENAME))                                     ;Retrieve list of entities data 
       (while                                                          ;Continue to evaluate expression till nil
         (/= (cdr (assoc 0 ELIST)) "SEQEND")                           ;Look for assoc list element, 0 entity type, If not =, End sequence
         (setq ELIST (entget ENAME))                                   ;Retrieve entity's data 
         (if                                                           ;If the following returns true
           (= "[color=red]TAP-VAL[/color]" (cdr (assoc 2 ELIST)))                         [color=red];If[/color][color=red] attribute tag is found ~ (Change the attribute tag value here.)[/color]
           (progn                                                      ;Then do the following
             (entmod                                                   ;Modify the definition data of an object (entity)
               (subst                                                  ;Then substitute
                 (cons 50 (AVR_DTR A:ANG#))                            ;New attribute angle
                 (assoc 50 ELIST) ELIST                                ;Replace old attribute angle
               )                                                       ;End subst
             )                                                         ;End entmod
             (entupd ENAME)                                            ;Update the attribute
           )                                                           ;End progn
         )                                                             ;End if
         (setq ENAME (entnext ENAME))                                  ;Get the next attribute
       )                                                               ;End while
       (setq INDEX (1+ INDEX))                                         ;Add one to INDEX
     )                                                                 ;End repeat
   )                                                                   ;End progn
   (ALERT "\nNo blocks were not found.")                               ;Display ALERT if selected blocks are not found
 )                                                                     ;End if
 (setq *error* temperr)                                                ;Restore error
 (setvar "cmdecho"   SUCE)                                             ;Restore saved user cmdecho
 (setvar "angbase"   SUAB)                                             ;Restore saved user angbase
 (setvar "angdir"    SUAD)                                             ;Restore saved user angdir
 (princ)                                                               ;Exit quietly
)                                                                       ;End define function
(princ "\nAttribute Value Rotate Lisp, AVR.lsp Loaded....")             ;Print Expression to command line
(princ "\nType AVR to start program.")                                  ;Print Expression to command line
;///////////////////////////////////////////////////////////////////////
; Conversion Function - Degrees to Radians.
(defun AVR_DTR (a)                                                      ;Define function
(* pi (/ a 180.0))                                                     ;Calculate degrees to radians
)                                                                       ;End of define function
;///////////////////////////////////////////////////////////////////////
; Error Trap Function.
(defun AVR_ET (ERRORMSG)                                                ;Define function, ERRORMSG ~ (Error Message) is the argument
 (command nil nil nil)                                                 ;When escape selected
 (if                                                                   ;If the following returns true
   (not                                                                ;And does not evalute to nil
     (member ERRORMSG                                                  ;Search list for an occurence of an expression
      '("console break" "Function Cancelled")                          ;Start list
     )                                                                 ;End member
   )                                                                   ;End not
   (princ (strcat "\nError:" ERRORMSG))                                ;Concatenate string, Show the error message
 )                                                                     ;End if
 (setvar "cmdecho"   SUCE)                                             ;Restore saved user cmdecho
 (setvar "angbase"   SUAB)                                             ;Restore saved user angbase
 (setvar "angdir"    SUAD)                                             ;Restore saved user angdir
 (princ  "\nAttention! An error has occurred!")                        ;Inform user there has been an error
 (princ  "\nProgram now restoring the user enviroment.")               ;Inform user original enviorment is being restored
 (terpri)                                                              ;Terminate print
 (setq *error* temperr)                                                ;Restore error
 (princ)                                                               ;Exit quietly
)                                                                       ;End of define function
(princ)                                                                 ;Exit quietly
;///////////////////////////////////////////////////////////////////////

Not sure, It seems to work.

Whats wrong?

Try a drawing with no blocks in it

Try a drawing with no blocks in it

I see, no error trapping.

I will work on it, Thanks.

Try a drawing with no blocks in it

Lee,

I just tried it with no blocks and it reports no blocks found.

It does what its suppose to do.

What gives?

Take a look at the section I highlighted.

Note the parenthesis balance -

The code will run when loaded, not when invoked, and you will receive an error when trying to reset the cmdecho etc, as the associated variables will be nil.

Take a look at the section I highlighted.

 

Note the parenthesis balance -

 

The code will run when loaded, not when invoked, and you will receive an error when trying to reset the cmdecho etc, as the associated variables will be nil.

Sorry I was testing the version on my computer. I repasted another copy to that thread. Not sure what had happened.

Its the same version as far as I know.

But Thanks

Also, just a pointer, you can change this:

 (setq A:ANG#                                                          ;Set attribute angle ~ (real)
   (cond                                                               ;Conditional
     ((getreal (strcat "\nSpecify attribute angle < "A:ANG$" >:")))    ;Concatenate string, Get attribute angle, Display default ~ (string)
     (T (setq A:ANG# A:ANG#))                                          ;Attribute angle default ~ (real)
   )                                                                   ;End cond
 )

To this:

 (setq A:ANG#                                                          ;Set attribute angle ~ (real)
   (cond                                                               ;Conditional
     ((getreal (strcat "\nSpecify attribute angle < "A:ANG$" >:")))    ;Concatenate string, Get attribute angle, Display default ~ (string)
     (T A:ANG#)                                          ;Attribute angle default ~ (real)
   )                                                                   ;End cond
 )

Lee

Also, just a pointer, you can change this:

 

 (setq A:ANG#                                                          ;Set attribute angle ~ (real)
   (cond                                                               ;Conditional
     ((getreal (strcat "\nSpecify attribute angle < "A:ANG$" >:")))    ;Concatenate string, Get attribute angle, Display default ~ (string)
     (T (setq A:ANG# A:ANG#))                                          ;Attribute angle default ~ (real)
   )                                                                   ;End cond
 )

To this:

 

 (setq A:ANG#                                                          ;Set attribute angle ~ (real)
   (cond                                                               ;Conditional
     ((getreal (strcat "\nSpecify attribute angle < "A:ANG$" >:")))    ;Concatenate string, Get attribute angle, Display default ~ (string)
     (T A:ANG#)                                          ;Attribute angle default ~ (real)
   )                                                                   ;End cond
 )

 

Lee

Thanks Lee,

Some how the code that was posted was not the same code I have stored. I do not have a clue how that happened, But thank you for spotting it.