Rotate attribute Reactor

[MMS]

Nice code lee. Your code its work in AutoCAD Vanilla but not in ACAD PnID. I think ACAD n PnID have same code for reactor but actually is different .

 

Thanks,

 

UdaAf

[Lee Mac]

Thanks MMS

[markv]

Lets add a wrinkle? I have been looking at the code and trying to figure out how to modify it to rotate only the attributes I provide in a list and ignore all others. Basically "flip flopping" how it filters the attributes now. This will make the list alot shorter as well as easier to maintain as we receive 100s of drawings from outside vendors.

[Lee Mac]

Try this Mark, update the list as necessary:

 

;; ZeroAtt                                   ;;
;; Lee Mac  ~  03.03.10                      ;;
;; Sets Attribute Rotation to zero upon      ;;
;; block insertion, copy, mirror.            ;;
;; Type 'ZeroAtt' to Activate and Deactivate ;;

(defun c:ZeroAtt (/ Reac *ZeroLastEnt*)
 (vl-load-COM)

 (if (setq Reac
       (vl-some
         (function
           (lambda (reactor)
             (if (eq "Zero-Att"
                   (vlr-data reactor)) reactor)))

         (cdar (vlr-reactors :vlr-command-reactor))))

   (if (vlr-added-p Reac)
     
     (vlr-remove Reac)
     (vlr-add Reac))

   (setq Reac
     (vlr-command-reactor "Zero-Att"
       (list
         (cons :vlr-commandWillStart 'GetCommand)
         (cons :vlr-commandEnded     'ZeroAttribs)))))

 (if (vlr-added-p Reac)
   (princ "\n** ZeroAtt Reactor Activated **")
   (princ "\n** ZeroAtt Reactor Deactivated **"))

 (princ))


(defun GetCommand  (Reactor Args)
 (setq *ZeroLastEnt*
   (if (wcmatch (strcase (car Args)) "*COPY,*MIRROR")
     (entlast)))
 
 (princ))


(defun ZeroAttribs (Reactor Args / *error*
                                  GetLocked PutLocked GetEnts dxf
                ATAG BANG ENT I LOCKED NOTROT OBJ SS UFLAG)
 (vl-load-com)


 (setq AttLst '("TAG1")) ;; Atts to be Rotated
 

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 

 (defun GetLocked (/ lst)
   (vlax-for lay (vla-get-Layers *doc)
     (and (eq :vlax-true (vla-get-lock lay))
          (setq lst (cons lay lst))
          (vla-put-lock lay :vlax-false)))
   lst)
 

 (defun PutLocked (lst)
   (mapcar
     (function
       (lambda (x)
         (vla-put-lock x :vlax-true))) lst))
 

 (defun GetEnts  (ent)
   (if (setq ent (entnext ent))
     (cons ent (GetEnts ent))))
 

 (defun AngleCorrection (lAng)    
   (cond (  (and (> lAng (/ pi 2)) (<= lAng pi))
            (- lAng pi))
         
         (  (and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
            (+ lAng pi))

         (lAng)))
 

 (defun dxf (code ent)
   (cdr (assoc code (entget ent))))  
 

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object))))

       Args (strcase (car Args)))

 (cond (  (and (wcmatch Args "*INSERT,*EXECUTETOOL")
               (setq ent (entlast))

               (eq "AcDbBlockReference"
                   (vla-get-ObjectName
                     (setq obj (vlax-ename->vla-object ent))))
               
               (eq :vlax-true (vla-get-HasAttributes obj)))
        
          (setq uFlag  (not (vla-StartUndoMark *doc))
                Locked (GetLocked)

                bAng (vla-get-Rotation obj))
        
          (foreach att (append (vlax-invoke obj 'GetAttributes)
                               (vlax-invoke obj 'GetConstantAttributes))

            (setq aTag (strcase (vla-get-TagString att)))

            (if (and AttLst (vl-position aTag AttLst))
              (vla-put-rotation att 0.)))
        
          (PutLocked Locked)
          (setq uFlag (vla-EndUndoMark *doc)))

       (  (or (and (wcmatch Args "*MIRROR,*COPY,*ROTATE")
                   (setq ss  (ssget "_P" '((0 . "INSERT") (66 . 1)))))

              (and (wcmatch Args "*GRIP_ROTATE,*GRIP_MIRROR")
                   (setq ss (cadr (ssgetfirst)))
                   (eq "INSERT" (dxf 0 (ssname ss 0)))
                   (= (dxf 66 (ssname ss 0)) 1)))

          (if *ZeroLastEnt*
            (foreach x (GetEnts *ZeroLastEnt*)
              (if (and (eq "INSERT" (dxf 0 x)) (= 1 (dxf 66 x)))
                (ssadd x ss))))

          (setq uFlag  (not (vla-StartUndoMark *doc))
                Locked (GetLocked) i -1)                

          (while (setq ent (ssname ss (setq i (1+ i))))
            (setq obj (vlax-ename->vla-object ent))

            (setq bAng (vla-get-Rotation obj))

            (foreach att (append (vlax-invoke obj 'GetAttributes)
                                 (vlax-invoke obj 'GetConstantAttributes))

              (setq aTag (strcase (vla-get-TagString att)))
              
              (if (and AttLst (vl-position aTag AttLst))
                (vla-put-rotation att 0.))))

          (PutLocked Locked)
          (setq uFlag (vla-EndUndoMark *doc))))             

 (princ))

[markv]

Thanks I will give it a try

[MarcoW]

Lee, strange thing: when I use a block with TAG1 TAG2 TAG3 etc in the list "to be rotated to zero" then TAG3 is not rotated at insert. Now, if I manually rotate the block 260 degrees, then it does rotate TAG3 to zero degrees.

 

How come? I have no clue... I renamed the tag to TAG4 and it stays the same...

[Lee Mac]

Which code post # are you referring to - its been a while since I read this thread...

[MarcoW]

Which code post # are you referring to - its been a while since I read this thread...

 

I have been playing with it, like this:

 

;; ZeroAtt                                   ;;
;; Lee Mac  ~  0?.0?.10                      ;;
;; Sets Attribute Rotation to zero upon      ;;
;; block insertion, copy, mirror.            ;;
;; Type 'ZeroAtt' to Activate and Deactivate ;;

(defun c:arof (/ reac *zerolastent*)
 (vl-load-com)
 (if (and (setq reac (vl-some (function (lambda (reactor)
       (if (eq "Zero-Att" (vlr-data reactor))
         reactor
       )
     )
         )
         (cdar (vlr-reactors :vlr-command-reactor))
       )
   )
   (vlr-added-p reac)
     )
   (progn (vlr-remove reac)
   (princ "\t\t« « Attribuut Reactor geDeactiveerd » »")
   )
   (princ "\t\t« « Attribuut Reactor niet in bedrijf » »")
 )
 (princ)
)

(defun aro (/ reac *zerolastent*)
 (vl-load-com)
 (if (setq reac (vl-some (function (lambda (reactor)
         (if (eq "Zero-Att" (vlr-data reactor))
    reactor
         )
       )
    )
    (cdar (vlr-reactors :vlr-command-reactor))
  )
     )
   (if (not (vlr-added-p reac))
     (progn (vlr-add reac)
     ;(princ "\t\t« « Attribuut Reactor GeActiveerd » »")
     )
     (princ "\t\t« « Attribuut Reactor reeds in bedrijf » »")
   )
   (progn (setq reac (vlr-command-reactor
  "Zero-Att"
  (list (cons :vlr-commandwillstart 'getcommand)
        (cons :vlr-commandended 'zeroattribs)
  )
       )
   )
   ;(princ "\t\t« « Attribuut Reactor GeActiveerd » »")
   )
 )
 (princ)
)

(defun getcommand (reactor args)
 (setq *zerolastent*
 (if (wcmatch (strcase (car args)) "*COPY,*MIRROR,*MOVE")
   (entlast)
 )
 )
 (princ)
)

(defun zeroattribs (reactor args / *error* getlocked putlocked getents dxf atag attlst bang ent i locked obj rotlst ss
     uflag)
 (vl-load-com)
 (setq attlst '("GROEP" "SCHAK"[color=red][b] "CODE"[/b][/color]))
 ;; Atts to be Rotated (nil for all)
 (setq rotlst '("DOEL"))
 ;; Atts to be Rotated to Block Angle
 (defun *error* (msg)
   (and uflag (vla-endundomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
   )
   (princ)
 )
 (defun getlocked (/ lst)
   (vlax-for lay (vla-get-layers *doc)
     (and (eq :vlax-true (vla-get-lock lay))
   (setq lst (cons lay lst))
   (vla-put-lock lay :vlax-false)
     )
   )
   lst
 )
 (defun putlocked (lst)
   (mapcar (function (lambda (x) (vla-put-lock x :vlax-true)))
    lst
   )
 )
 (defun getents (ent)
   (if (setq ent (entnext ent))
     (cons ent (getents ent))
   )
 )
 (defun anglecorrection (lang)
   (cond ((and (> lang (/ pi 2)) (<= lang pi)) (- lang pi))
  ((and (> lang pi) (<= lang (/ (* 3 pi) 2))) (+ lang pi))
  (lang)
   )
 )
 (defun dxf (code ent) (cdr (assoc code (entget ent))))
 (setq *doc (cond (*doc)
    ((vla-get-activedocument (vlax-get-acad-object)))
     )
args (strcase (car args))
 )
 (cond ((and (wcmatch args "*INSERT,*EXECUTETOOL")
      (setq ent (entlast))
      (eq "AcDbBlockReference"
   (vla-get-objectname (setq obj (vlax-ename->vla-object ent)))
      )
      (eq :vlax-true (vla-get-hasattributes obj))
 )
 (setq uflag  (not (vla-startundomark *doc))
       locked (getlocked)
       bang   (vla-get-rotation obj)
 )
 (foreach att (append (vlax-invoke obj 'getattributes)
        (vlax-invoke obj 'getconstantattributes)
       )
   (setq atag (strcase (vla-get-tagstring att)))
   (cond ((and attlst (vl-position atag attlst))
   (vla-put-rotation att 0.)
  )
  ((and rotlst (vl-position atag rotlst))
   (vla-put-rotation att (anglecorrection bang))
  )
  (t (vla-put-rotation att 0.))
   )
 )
 (putlocked locked)
 (setq uflag (vla-endundomark *doc))
)
((or (and (wcmatch args "*MIRROR,*COPY,*ROTATE,*MOVE")
   (setq ss (ssget "_P" '((0 . "INSERT") (66 . 1))))
     )
     (and (wcmatch args "*GRIP_ROTATE,*GRIP_MIRROR,*GRIP_STRETCH")
   (setq ss (cadr (ssgetfirst)))
   (eq "INSERT" (dxf 0 (ssname ss 0)))
   (= (dxf 66 (ssname ss 0)) 1)
     )
 )
 (if *zerolastent*
   (foreach x (getents *zerolastent*)
     (if (and (eq "INSERT" (dxf 0 x)) (= 1 (dxf 66 x)))
       (ssadd x ss)
     )
   )
 )
 (setq uflag  (not (vla-startundomark *doc))
       locked (getlocked)
       i      -1
 )
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq obj (vlax-ename->vla-object ent))
   (setq bang (vla-get-rotation obj))
   (foreach att (append (vlax-invoke obj 'getattributes)
   (vlax-invoke obj 'getconstantattributes)
  )
     (setq atag (strcase (vla-get-tagstring att)))
     (cond ((and attlst (vl-position atag attlst))
     (vla-put-rotation att 0.)
    )
    ((and rotlst (vl-position atag rotlst))
     (vla-put-rotation att (anglecorrection bang))
    )
    (t (vla-put-rotation att 0.))
     )
   )
 )
 (putlocked locked)
 (setq uflag (vla-endundomark *doc))
)
 )
 (princ)
)
(aro); automatic run
(princ)

 

The red part isn't working allthough I am 1000% shure the attributes tag is CODE. I changed the tag and the lisp to TESTCODE but it doesn't seem to work.

[Lee Mac]

The code looks Ok to me - is it possibly a Constant Attribute?

[MarcoW]

No it is the same as other attributes...

THere is something very simple going wrong, I (we) are just not looking in the right place I believe.

[MarcoW]

(setq attlst '("GROEP" "SCHAK" "CODE"))

 

Even if I use totally crap TAGS it keeps on rotating them.... hmmm I do not get much further...

[MarcoW]

edit:

 

I noticed the attributes rotate by another routine. So I figure the this reactor does all attributes on action after insert. On insert it only seems to be working on the first 2 TAGS.

 

As for me the problem is solved but somehow there is something going wrong in this lisp. As said I am fine but maybe others.

 

Lee thanks for trying anyway.