Single Att rotate

Hello,

I have a lisp that rotates the attributes from a selected block. Can it be changed that only the selected attributes rotates and not all of them.

There are multiple attributes in a block and they all need a different angle.

(defun c:atrot(/ blSet attLst errCount oldAng)
 (if(not atrot:rAng)(setq atrot:rAng 0))
 (setq oldAng atrot:rAng
       atrot:rAng
    (getangle
      (strcat "\nSpecify rotation angle <"(angtos atrot:rAng)">: ")))
 (if(not atrot:rAng)(setq atrot:rAng oldAng))
 (princ "<<< Select blocks to rotate attributes >>>")
 (setq errCount 0)
 (if
   (setq blSet(ssget '((0 . "INSERT")(66 . 1))))
   (progn
     (setq blSet(mapcar 'vlax-ename->vla-object 
                   (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex blSet)))))
     (foreach itm blSet
   (setq attLst
          (vlax-safearray->list
        (vlax-variant-value
          (vla-GetAttributes itm))))
   (foreach att attLst
     (if(vl-catch-all-error-p
          (vl-catch-all-apply
            'vla-put-Rotation(list att atrot:rAng)))
       (setq errCount(1+ ErrCount))
         ); end if
     ); end foreach
   ); end foreach
     ); end progn
   (princ ">>> Nothing selected! <<<")
   ); end if
 (if(/= 0 errCount)
   (princ
     (strcat "\n>>> "
   (itoa errCount)
         " attributes or blocks were on locked layer! <<< "))
         ); end if
 (princ)
 ); end of c:atrot

Thank you in advance,

PMXcad

Are you after something like this?

(defun c:atrot(/ blSet attLst errCount oldAng TagS response)
 (if(not atrot:rAng)(setq atrot:rAng 0))
 (setq oldAng atrot:rAng
       atrot:rAng
    (getangle
      (strcat "\nSpecify rotation angle <"(angtos atrot:rAng)">: ")))
 (if(not atrot:rAng)(setq atrot:rAng oldAng))
 (princ "<<< Select blocks to rotate attributes >>>")
 (setq errCount 0)    
 (if
   (setq blSet(ssget '((0 . "INSERT")(66 . 1))))
   (progn
     (setq blSet(mapcar 'vlax-ename->vla-object 
                   (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex blSet)))))
     (foreach itm blSet
   (setq attLst
          (vlax-safearray->list
        (vlax-variant-value
          (vla-GetAttributes itm))))
   (foreach att attLst
     (progn 
     (initget "Y N")
     (setq TagS (vlax-get-property att 'TagString))
     (if (eq TagS nil)
   (setq response (getkword "Rotate Y/N?"))
         (setq response (getkword (strcat TagS " Rotate Y/N?")))
     )
     (if (eq response "Y")
     (if
   
   (vl-catch-all-error-p

       (vl-catch-all-apply
           'vla-put-Rotation(list att atrot:rAng)
       )
      
      )
       (setq errCount(1+ ErrCount))
         ); end if
       ); endif
     );end progn
     ); end foreach

   ); end foreach
     ); end progn
   (princ ">>> Nothing selected! <<<")
   ); end if
 (if(/= 0 errCount)
   (princ
     (strcat "\n>>> "
   (itoa errCount)
         " attributes or blocks were on locked layer! <<< "))
         ); end if
 (princ)
 ); end of c:atrot

Sorry if I've stuffed up your indenting....

Just re-read your post, this asks for angles for each object:

(defun c:atrot(/ blSet attLst errCount oldAng TagS response)
 (if(not atrot:rAng)(setq atrot:rAng 0))
;;;  (setq oldAng atrot:rAng
;;;        atrot:rAng
;;;     (getangle
;;;       (strcat "\nSpecify rotation angle <"(angtos atrot:rAng)">: ")))
;;;  (if(not atrot:rAng)(setq atrot:rAng oldAng))
 (princ "<<< Select blocks to rotate attributes >>>")
 (setq errCount 0)    
 (if
   (setq blSet(ssget '((0 . "INSERT")(66 . 1))))
   (progn
     (setq blSet(mapcar 'vlax-ename->vla-object 
                   (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex blSet)))))
     (foreach itm blSet
   (setq attLst
          (vlax-safearray->list
        (vlax-variant-value
          (vla-GetAttributes itm))))
   (foreach att attLst
     (progn 
     (initget "Y N")
     (setq TagS (vlax-get-property att 'TagString))
     (if (eq TagS nil)
   (setq response (getkword "Rotate Y/N?"))
         (setq response (getkword (strcat TagS " Rotate Y/N?")))
     )
     (if (eq response "Y")
       (progn
         (setq atrot:rAng
         (getangle
              (strcat "\nSpecify rotation angle <"(angtos atrot:rAng)">: ")))
         (if (eq nil atrot:rAng)
       (setq atrot:rAng 0)
       )
         
     (if
   
   (vl-catch-all-error-p

       (vl-catch-all-apply
           'vla-put-Rotation(list att atrot:rAng)
       )
      
      )
       (setq errCount(1+ ErrCount))
         ); end if
       );end progn
       ); endif
     );end progn
     ); end foreach

   ); end foreach
     ); end progn
   (princ ">>> Nothing selected! <<<")
   ); end if
 (if(/= 0 errCount)
   (princ
     (strcat "\n>>> "
   (itoa errCount)
         " attributes or blocks were on locked layer! <<< "))
         ); end if
 (princ)
 ); end of c:atrot

Good job alm865. Almost perfect.

Can it be made simpler? ATROT -> angle -> pick attribute -> done.

And for the other attributes i wil do the same....running ATROT.

There are blocks with a lot of attributtes, like 10. And it could be that a attribute is the last one. By selecting a attribute for rotating.i scip the other attributes.

PMXcad

Well there's lots of ways to do it.

If it was me I'd do a first pass with your script and create a list of attributes. Send the list to a 'list box in a dialog' for user selection (i.e. create a DCL file). The user returns the list and you check that each item is a member of the user's selection. Kind of like how the new 'laydel' command works if you choose selection by name.

If I get some time I'll post an example unless someone beats me to it with a better way ;-)

Okay Alm865, it's solved. I found a lisp in my lisp database. This does exactly what I want and more.

See code:

;*  Variables ans   = given answer to what to change                     *
;*            tmp   = temporary storage                                  *
;*            alist = storage of separate selections (check list)        *
;*            pt    = storage for point selections                       *
;*            sset  = selection set storage ( check for entity )         *
;*            cnt   = storage for counter vs. string length              *
;*************************************************************************
; 
(defun c:chatt
    ( / cnt ans tmp alist pt sset value angle style layer color hgt pos)
       (setq ans "")
       (setq tmp " ")
       (setq alist (list ""))
       (While (/= tmp "")                           ; Continue if user
                                                    ; gives us an answer.
         (prompt "\nChange what?\nValue, Angle,")
         (prompt " Style, Layer, Color, Height, Position:"); Long eh?
         (if (> (strlen ans) 0)
           (progn
            (prompt "\nCurrent[")                   ; Display the current
            (prompt ans)                            ; list if available.
            (prompt "]:")
           )
         )
         (setq tmp (strcase (substr (getstring) 1 1)))
         (if (AND (or (= tmp "V")(= tmp "A")(= tmp "S")(= tmp "L")
                      (= tmp "C")(= tmp "H")(= tmp "P"))
                  (= nil (member tmp alist))
              )                                     ; If the answer is in the
           (progn                                   ; group and not in the 
            (setq ans(strcat ans tmp))              ; check list add it!
            (setq alist (append alist (list tmp)))
           )
         )
       )
       (if (= ans "")(setq ans "VASLCHP"))          ; If the user doesn't
       (setq cnt 1)                                 ; us an option force
       (setq value nil)                             ; all of them!
       (setq angle nil)
       (setq style nil)                             ; Set all the variables
       (setq layer nil)                             ; to nil!
       (setq color nil)                             ; I'm not very trusting!
       (setq hgt nil)
       (setq pos nil)
       (While (/= "" (setq tmp (substr ans cnt 1))) ; Check for options and
                                                    ; get the values.
         (if (= tmp "V")
          (setq value (getstring "\nNew Value for attributes: "))
         )
         (if (= tmp "A")
          (setq angle (* 180 (/ (getangle "\nNew angle for attributes: ") 
                       pi)))
         )
         (if (= tmp "S")
          (setq style (getstring "\nNew style for attributes: "))
         )
         (if (= tmp "L")
          (setq layer (getstring "\nNew layer for attributes: "))
         )
         (if (= tmp "C")
          (setq color (getstring "\nNew color for attributes: "))
         )
         (if (= tmp "H")
             (setq hgt (getdist "\nNew height for attributes: "))
         )
         (if (= tmp "P")(setq pos 1))
         (setq cnt (+ cnt 1))
       )
       (setvar "cmdecho" 0)
       (setq pt (getpoint "\nSelect Attribute: "))  ; As long as we get a
       (while pt                                    ; point value!
         (if  (setq sset (ssget pt))                ; Check for an entity!
            (progn
               (if (= nil (assoc 66 (entget (ssname sset 0))))
                 (progn                             ; If it does not have
                                                    ; Attributes worry!

                   (prompt "\nNot An Attributed Block")
                   (setq sset nil)
                 )
               )
            )
            (progn                                  ; If you dont find
              (prompt "\nNo Entity Found")          ; an entity at the
              (setq sset nil)                       ; given location
            )                                       ; worry!
         )
        (if (and pt sset)
         (progn                                     ; If all is well,
         (command ".attedit" "" "" "" "" pt "" )    ; Start the ATTEDIT
         (if value (command "v" "r" value))         ; function and do
         (if angle (command "a" angle))             ; each one that was
         (if style (command "s" style))             ; requested and
         (if layer (command "l" layer))             ; that has a value.
         (if color (command "c" color ))
         (if hgt (command "h" hgt ))                ; If the position
         (if pos                                    ; was requested,
           (progn                                   ; give an additional
             (Prompt "\n New Position: ")           ; prompt since we
             (command "p" pause )                   ; turned off the
           )                                        ; command echo!
         )
         (command "")                               ; Terminate the
         )                                          ; command.
        )
        (setq pt (getpoint "\nSelect Attribute: ")) ; Get a new point!
       )
)
;/* End of File */

still thanks for your time

PMXcad

This post may have some thing useful http://www.cadtutor.net/forum/showthread.php?97667-Auto-rotaing-text-to-any-UCS