Rotate all attributes with a specific tag.

[Lee Mac]

Not a problem

[Astro]

Hi all,

hope somebody can help me with this lisp.

 

I want to select one ore more blocks. Then the lisp scan the block for a list off attributes, TAG1" "TAG2" "TAG3".

And if the rotation angle is not 0 it rotates it to 0, and after give me the option to move the attributes.

 

 

 
(defun c:ROTATEMOVEATTRIBUTE1 (/ tag ss sel)
 (vl-load-com)
 (setq tag '("TAG1" "TAG2" "TAG3"))  ;; <<-- Tag to be Searched
 (and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
      (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet
                                (vla-get-ActiveDocument (vlax-get-acad-object))))
         (foreach att (append (vlax-invoke Obj 'GetAttributes)
                              (vlax-invoke Obj 'GetConstantAttributes))
           (if (vl-position (strcase (vla-get-TagString att)) tag)
             (vla-put-Rotation attVar 0
               (cond ((eq :vlax-true (vla-put-Rotation attVar 90)) :vlax-false)
                     (:vlax-true))))))
      (vla-delete sel))
 (princ))

[The Buzzard]

Hi all,

hope somebody can help me with this lisp.

 

I want to select one ore more blocks. Then the lisp scan the block for a list off attributes, TAG1" "TAG2" "TAG3".

And if the rotation angle is not 0 it rotates it to 0, and after give me the option to move the attributes.

 

 

 
(defun c:ROTATEMOVEATTRIBUTE1 (/ tag ss sel)
 (vl-load-com)
 (setq tag '("TAG1" "TAG2" "TAG3"))  ;; <<-- Tag to be Searched
 (and (setq ss (ssget '((0 . "INSERT") (66 . 1))))
      (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet
                                (vla-get-ActiveDocument (vlax-get-acad-object))))
         (foreach att (append (vlax-invoke Obj 'GetAttributes)
                              (vlax-invoke Obj 'GetConstantAttributes))
           (if (vl-position (strcase (vla-get-TagString att)) tag)
             (vla-put-Rotation attVar 0
               (cond ((eq :vlax-true (vla-put-Rotation attVar 90)) :vlax-false)
                     (:vlax-true))))))
      (vla-delete sel))
 (princ))

 

 

I wish I could help you there Astro, But I am not fully versed in Visual Lisp as of yet. I am sure if you post this to a new thread by itself, You will get plenty of replies with help.

 

Give it a shot,

Good Luck,

The Buzzard

[Astro]

Ok thanks, i will give it a try

[Lee Mac]

I recognise that

 

http://www.cadtutor.net/forum/showthread.php?t=38970

[acampbell@cdfl.com]

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)))  

 

 

Is there any way to make this routine able to select multiple attributes at one time. By the way this is exactly to kink of routine me and my co-workers have been looking for for a while.

[Lee Mac]

See here:

 

http://www.cadtutor.net/forum/showthread.php?t=37859