Rotate attribute Reactor

March 4, 2010

perhaps he said...

Yes Lee, that is a lot better.

I have a lot of thinking to do... --> I want to apply it in my menustructure.

Thanks for the help!!

March 4, 2010

No worries Marco, you've just got to think outside the box a bit, and see the whole picture

March 12, 2010

This program works very well. Almost too well! How can I make it ignore nested blocks? I am having problems extracting attributes if I lock down the attributes so they do not rotate with the reactor. The attributes happen to be in a nested block.

March 12, 2010

This program works very well. Almost too well! How can I make it ignore nested blocks? I am having problems extracting attributes if I lock down the attributes so they do not rotate with the reactor. The attributes happen to be in a nested block.

They shouldn't get rotated if they are nested (at least they don't for me)...

Here is a quick fix:

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

[color=Red][b]
 (setq NotRot '("TAG1")) ;; Atts not to be Rotated (can be nil)[/b][/color]
 

 (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 NotRot (vl-position aTag NotRot)))

                  (t (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)))
              
              (cond (  (and NotRot (vl-position aTag NotRot)))

                    (t (vla-put-rotation att 0.)))))

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

 (princ))

Change the list as necessary.

Else, I suppose you could compare the Owner ID's of the Attributes and the ObjectID of the Block in which the block is nested.

March 12, 2010

I must have missed that post. I was mistaken. The user had a drawing where some of the blocks were exploded. I now have the tags listed to not rotate. I can add to the list now as needed and maybe by some miracle I will eventually have them all listed. thanks again.

March 12, 2010

I must have missed that post. I was mistaken. The user had a drawing where some of the blocks were exploded. I now have the tags listed to not rotate. I can add to the list now as needed and maybe by some miracle I will eventually have them all listed. thanks again.

Exploding Blocks!

March 18, 2010

Lee,

I am scanning the routine to find out how the toggle works... Can you explain that to me? I would like to modify the code so that "zeroatton" will turn it on and "zeroattoff" turns it of.

I can't even tell where to start...

If I am right then the reactor is activated whenever the variable Reac is true. If not true then it is deactivated.

Reac is set by this:

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

But I am not able to tell what part of the code is responsible...

Tnx in advance!

Oh and by the way I had a routine to insert blocks: the reactor did not work ont that kind of inserting. If the block is inserted the attributes stay as they are. But if moved 1 mm then they are rotated. How come?

March 18, 2010

If I am right then the reactor is activated whenever the variable Reac is true. If not true then it is deactivated.

No, the reactor data is tested for the string "Zero-Att" which identifies the reactor. If found, and the reactor is enabled, then the reactor is disabled, else is enabled. Else the reactor is created. Notice that 'Reac' is not global.

Oh and by the way I had a routine to insert blocks: the reactor did not work ont that kind of inserting. If the block is inserted the attributes stay as they are. But if moved 1 mm then they are rotated. How come?

The reactor is a command reactor, and will only react to the user using the INSERT command (and other commands).

March 18, 2010

An example of using separate functions:

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

(defun c:ZeroAttOFF (/ 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 "\n** ZeroAtt Reactor Deactivated **"))

   (princ "\n** ZeroAtt Reactor Not Running **"))

 (princ))


(defun c:ZeroAttON (/ 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 "\n** ZeroAtt Reactor Activated **"))
     
     (princ "\n** ZeroAtt Reactor Already Running **"))

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

     (princ "\n** ZeroAtt Reactor Activated **")))
 
 (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 NotRot nil) ;; Atts not to be Rotated (can be nil)
 

 (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 NotRot (vl-position aTag NotRot)))

                  (t (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)))
              
              (cond (  (and NotRot (vl-position aTag NotRot)))

                    (t (vla-put-rotation att 0.)))))

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

 (princ))

Uglier coding this way.

March 18, 2010

Lee you are too fast with the codes, I did not even understand your first reply

I see Reac is not global... so it is empty when activating the command and when ending it is also empty. (I mean NIL)

The routine I was talking about had this in it:

 
(vl-cmdf "._insert" blockname (cadr linput) PlotScale "" "")

So I figured it is an insert command.

Appears not to be...

I know what the vl-cmdf does but is this a problem when combining it with the attribute rotator?

March 18, 2010

Yes, the variable 'Reac' is localised and hence is set to nil upon function invocation and completion.

As for the insert being issued within a LISP, I could be wrong, but I don't think the reactor is triggered during a LISP, you may need to look into a vlr-lisp-reactor for that.

Lee

March 18, 2010

I have searched google and nothing found !

No just kidding: lots of information but I get a headache of it all. This is way out of my league. But I get what you mean: the reactor is triggered on 1 or more commands, like insert.

WHen in a lisp it is not "seen as insert" allthough it is inserted.

Thanks for the quick replies!

March 18, 2010

Google wouldn't have been my first port of call, I would first look up any function in the Visual LISP Help files - much quicker to get at the necessary info.

March 18, 2010

I search google to find an example: that works better for me.

In the help files it is to "plain" explained. I do read it but I do not get it.

Just for you to know: I do speak english but reading and understanding lisp explain is a whole other thing.

The whole reactor thing is a bit difficult anyway but I can live with me not getting to it.

not.

March 18, 2010

I search google to find an example: that works better for me.
In the help files it is to "plain" explained. I do read it but I do not get it.

Just for you to know: I do speak english but reading and understanding lisp explain is a whole other thing.

The whole reactor thing is a bit difficult anyway but I can live with me not getting to it.

not.

Yes, I would agree reactors are a more advanced area of LISP so don't worry if you don't get the hang of it straight away. They are pretty powerful tools when used properly though.

Lee

EDIT: Just remembered AfraLISP has a pretty good section on reactors:

http://afralisp.net/vl/reactors1.htm

March 31, 2010

Is it somehow possible to change this lisp, so that one command activates the reactor and another deactivates it?

March 31, 2010

You should have a look at #24 in this topic

Lee answered that allready!

Or am I missing your goal?

April 1, 2010

My goal is to insert some blocks in 0, 90, 180 and 270 degrees in different positions.

I'm using *.scr file for that, and I'm trying to insert them so, that attribute text is allways 90 or 0 degrees.

I almost could use Lee Mac LISP, I allready have modified it to work 270 --> 90 degrees, but there is no separate off command in it.

Here is a sample from my scr file using atron.lisp (from Lee Mac #2 post)

the problem here is that I haven't figured out how to get it working with 270 --> 90 degrees..

 
ATROFF ATRON INSERT "C:\My Documents\My Pictures\Uued Blokid\0603.DWG" 1.9,43.5 1 1 180 C9
ATROFF ATRON INSERT "C:\My Documents\My Pictures\Uued Blokid\0603.DWG" 39.5,92.1 1 1 180 C17
ATROFF INSERT "C:\My Documents\My Pictures\Uued Blokid\0603.DWG" 2.1,49.3 1 1 0 C18
ATROFF ATRON INSERT "C:\My Documents\My Pictures\Uued Blokid\0603.DWG" 61.8,31.7 1 1 180 C19
ATROFF ATRON INSERT "C:\My Documents\My Pictures\Uued Blokid\SOT-23.DWG" 12.7,33 1 1 180 Q20
ATROFF INSERT "C:\My Documents\My Pictures\Uued Blokid\0603.DWG" 49.5,78 1 1 0 C21
ATROFF ATRON INSERT "C:\My Documents\My Pictures\Uued Blokid\SO8.DWG" 49.5,73 1 1 180 U22

April 1, 2010

Bear in mind that this is a reactor and should not be invoked upon every use, it functions automatically.

April 7, 2010

The problem is, that I have to use for INSERT two different reactors alternately one for 180 to 0 degree and 270 to 90 degree and also without reactors.

That's why I have to shut off the reactors after every use. In my case I have to start every line in scr file wiht shut off command to make sure it is off.

I could use a separate insrot.lsp

(defun c:insrot180 ()
(setq cmdecho (getvar "CMDECHO"))
(setq attdia (getvar "ATTDIA"))
(setvar "ATTDIA" 1)
(setvar "CMDECHO" 1)
(if (>= (atoi (getvar "ACADVER")) 15)
 (progn
   (initdia 1)
   (command "_.-INSERT")
 )
 (command "_.INSERT")
)
(while (eq 1 (logand 1 (getvar "CMDACTIVE")))
 (command pause)
)
(setq ins (entlast))
(setq ent (entget ins))
(setq pnt (cdr (assoc 10 ent)))
(setq rot (cdr (assoc 50 ent)))
(setq use (* (/ rot pi) 180.0))
(setq use (- 0.0 use))
(setvar "CMDECHO" 0)
(command "_.ROTATE" ins "" pnt use)
(setq ent (subst (cons 50 rot)(assoc 50 ent) ent))
(entmod ent)
(setvar "ATTDIA" attdia)
(setvar "CMDECHO" cmdecho)
(princ)
)

but there appears an unexpected problem. I have no idea where this " \ " mark is coming

Here is the line from my *.scr file:

INSROT180 "C:\My Documents\My Pictures\Uued Blokid\0603.DWG" 1.9,43.5 1 1 180 C9

And here is the result from command line:

Command: SCR
SCRIPT
Command: INSROT180 _.-INSERT Enter block name or [?]: "C:\My Documents\My
Pictures\Uued Blokid\0603.DWG"
Units: Millimeters   Conversion:    1.0000
Specify insertion point or
[basepoint/Scale/X/Y/Z/Rotate/PScale/PX/PY/PZ/PRotate]: 1.9,43.5
Enter X scale factor, specify opposite corner, or [Corner/XYZ] <1>: 1 Enter Y
scale factor <use X scale factor>: 1
Specify rotation angle <0>: 180
Enter attribute values
TAK <TAK>: \
Command:

Command: C9

The same thing works fine with just INSERT command, but can enyone explain why there is " / " instead of C9?

Sign In

Rotate attribute Reactor

Recommended Posts

MarcoW

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Lee Mac

markv

Lee Mac

markv

Lee Mac

MarcoW

Lee Mac

Lee Mac

MarcoW

Lee Mac

MarcoW

Lee Mac

MarcoW

Lee Mac

YvaaT

MarcoW

YvaaT

Lee Mac

YvaaT

Join the conversation

Tutorials

Forums

Activity