A Spin on Attributes...? Can this be done??

[ASMI]

Idea in AMOVE.pdf is good, however we deal with various blocks. Therefore I have written a reactor at command INSERT. To Swich ON reactor type ATRON, to Switch OFF - ATROFF.

After any blok insertion reactor will to rotate all attributes to 0 degrees, requests to fill attributes (if ATTREQ = 1) and requests to pick point for a new attributes location (move green rectangle and click, box dimensions as attributes boundary box).

(defun c:atron()
  (vl-load-com)
  (if(not aton:cmdreactor)
    (progn
      (setq aton:cmdreactor
	   (vlr-Command-Reactor nil
	     '((:vlr-CommandEnded . Atron_Arrange_Attributes))))
      (princ "\n<<< Insert Reactor now ON >>> ")
      ); end progn
    (princ "\n<<< Insert reactor already ON! Type ATROFF to OFF >>> ")
    );end if
  (princ)
  ); end of c:atron

(defun c:atroff()
  (if aton:cmdreactor
    (progn
      (vlr-remove aton:cmdreactor)
      (setq aton:cmdreactor nil)
      (princ "\n<<< Insert Reactor now OFF >>> ")
     ); end progn
    ); end if
  (princ)
  ); end of c:atroff

(defun Atron_Arrange_Attributes (Reac Args / cBl atLst minPt maxPt
				ptLst cPt errCnt rAng mPt xPt laySt
				pLst mX mY xX xY p1 p2 p3 p4 hX hY
				sPt grDat fPt stFlag actDoc stFlag
				stopFlag *error*)

 (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); end if
     (if
       (not
         (vl-catch-all-error-p
           (setq caArr(vl-catch-all-apply 'vlax-safearray->list
             (list
               (vlax-variant-value
                 (vla-GetConstantAttributes Block)))))))
             caArr); end if
      ); end append
    ); end asmi-GetAttributes

(defun asmi-LayersUnlock(/ restLst)
  (setq restLst '())
  (vlax-for lay(vla-get-Layers
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
         (setq restLst
           (append restLst
             (list
               (list
                 lay
                  (vla-get-Lock lay)
                 ); end list
               ); end list
             ); end append
           ); end setq
        (vla-put-Lock lay :vlax-false)
      ); end vlax-for
   restLst
  ); end of asmi-LayersUnlock

  (defun asmi-LayersStateRestore(StateList)
    (foreach lay StateList
      (vla-put-Lock(car lay)(cadr lay))
     ); end foreach
    (princ)
  ); end of asmi-LayersStateRestore

  (defun *error*(msg)
    (if stFlag
      (vla-EndUndoMark actDoc)
      ); end if
    (redraw)
    (princ(strcat "\n" msg))
    (princ)
    ); end of *error*
  
  (if
    (and
      (or
        (= "INSERT"(car Args))
        (= "EXECUTETOOL"(car Args))
       ); end or
      (entlast)
      (= "INSERT"(cdr(assoc 0(entget(entlast)))))
      (= :vlax-true
	  (vla-get-HasAttributes
	     (setq cBl(vlax-ename->vla-object(entlast)))))
      ); end and
    (progn
      (vla-GetBoundingBox cBl 'minPt 'maxPt)
      (setq atLst(asmi-GetAttributes cBl)
	    ptLst(mapcar 'vlax-safearray->list(list maxPt minPt))
	    cPt(vlax-3d-Point
		 (mapcar '+(cadr ptLst)
		   (mapcar '/(mapcar '-
		     (car ptLst)(cadr ptLst))'(2 2 1))))
	    rAng(vla-get-Rotation cBl)
	    actDoc(vla-get-ActiveDocument
		    (vlax-get-acad-object))
	    laySt(asmi-LayersUnlock)
	    ); end setq
      (setq stFlag T)
      (vla-StartUndoMark actDoc)
      (foreach att atLst
	(if(vl-catch-all-error-p
	     (vl-catch-all-apply 'vla-Rotate
	       (list att cPt (- rAng)))) nil
	  (progn
	    (vla-GetBoundingBox att 'mPt 'xPt)
	    (setq pLst
		   (append pLst
			(mapcar 'vlax-safearray->list
				      (list mPt xPt)))
		  ); end setq
	    ); end progn
	  ); end if
	); end foreach
      (setq mX(vl-sort pLst '(lambda(a b)(<(car a)(car b))))
	    mY(vl-sort pLst '(lambda(a b)(<(cadr a)(cadr b))))
	    xX(vl-sort pLst '(lambda(a b)(>(car a)(car b))))
	    xY(vl-sort pLst '(lambda(a b)(>(cadr a)(cadr b))))
	    hX(/(-(caar xX)(caar mX))2) hY(/(-(cadar xY)(cadar mY))2)
	    fPt(list(+(caar mX)hX)(+(cadar mY)hY)0.0)
	    ); end setq
      (princ "\n<<< Move attributes or Right Click to stay >>> ")
      (while(and
	      (/= 3(car(setq grDat(grread T 1))))
	      (not stopFlag)
	      ); end or
	(redraw)
	(if(= 'LIST(type(setq sPt(cadr grDat))))
	  (progn
	   (setq p1(list(-(car sPt)hX)(-(cadr sPt)hY))
	         p2(list(-(car sPt)hX)(+(cadr sPt)hY))
	         p3(list(+(car sPt)hX)(+(cadr sPt)hY))
	         p4(list(+(car sPt)hX)(-(cadr sPt)hY))
	      ); end setq
	    (grdraw p1 p2 3)(grdraw p2 p3 3)
	    (grdraw p3 p4 3)(grdraw p4 p1 3)
	   ); end progn
	     (if(= 25(car grDat))
                (setq sPt fPt
		      stopFlag T); end setq
	    ); end if
	  ); end if
	); end while
      (redraw)
      (foreach att atLst
	(if(vl-catch-all-error-p
	     (vl-catch-all-apply 'vla-Move
	       (list att(vlax-3D-point fPt)
		        (vlax-3D-point(trans sPt 1 0)))))
	  nil
	  ); end if
	); end foreach
       (if(and
	   (= "EXECUTETOOL"(car Args))
	   (= 1(getvar "ATTREQ"))
	   ); and end
             (vla-Eval(vlax-get-acad-object)
		 (strcat "ThisDrawing.SendCommand"
			 "\"_.acdcattedit\"" "& vbCr"))
	  ); end if
      (if laySt(asmi-LayersStateRestore laySt))
      (vla-EndUndoMark actDoc)
      ); end progn
    ); end if
  (princ)
  ); end of Atron_Arrange_Attributes

(princ "\n*** Type ATRON to Switch ON attribute reactor or ATROFF to Swich OFF *** ")

Is it usefull tool now or not?

[MarkytheSparky]

ASMI,

What a clever way to solve this problem.

I was thinking that it should be automatic instead of picking the new location - but your idea makes good sense... sometimes there is something in the way - where the attributes would go, your way allows you to avoid the problem and pick where the attibutes should go.

It is sort of what I was looking for, but better.

I can't wait to try it out tomorrow.

[MarkytheSparky]

ASMI,

This reactor works great if you type in the insert command.

However - this is how I insert blocks:

I define trigger commands in one long lisp:

Example:

(DEFUN c:2x4     () (load "2x4")      (c:2x4)    (princ))

Hundreds of these are defined at startup - I call them "triggers".

Then I have an icon menu that invokes the command.
Click the button and insert the block...

using a command similar to this:

(defun C:2x4 ( )
(setvar "cmdecho" 0)
(setvar "orthomode" 1)
(SETVAR "attreq" 0)
(setq ds (getvar "dimscale"))
(setq ip (getpoint "Insertion Point:"))
(setq clay (getvar "clayer"))
 (command "-layer" "s" "E-LITE-CLNG-NEW" "")
 (command "insert" "2x4" ip "" "" pause)
(SETVAR "attreq" 1)
;----------------------------------------------------------
(SETQ ENT (entlast))
(SETQ NXT (ENTNEXT ENT))
       (IF (/= NXT nil)
         (progn
               (SETQ VAR (ENTGET NXT))
               (WHILE (= (CDR (ASSOC 0 VAR)) "ATTRIB")
                  (SETQ VAR (SUBST '(50 . 0.0) (ASSOC 50 VAR) VAR))
                  (ENTMOD VAR)
                  (ENTUPD ENT)
                  (SETQ NXT (ENTNEXT NXT))
                  (SETQ VAR (ENTGET NXT))
               )
          )
       )
;----------------------------------------------------------
(SETVAR "attreq" 1)
 (setvar "clayer" clay)
(princ)
)

Everything between the ;---------------------------------------------------------- is the attribute rotate command that rotates the attribute to 0 degrees (horizontal).

when I load and turn on ATRON then run my command to insert the 2x4 block I get an error "Automation Error. Null extents".

I need to find a nice way of inserting your code into mine so that this command happens automatically.

Can you make the green box show up if Attreq = 0?

That would be ideal.... insert the block, green box comes up, pick new location - add attributes later.

Then I need to make a block editor that changes all the attributes in a selection set at once...

1. select set.
2. change all 1's attributes to user input.


then make one of these commands for all the second attributes.

then make one of these commands for all the third attributes.

This is what I have so far...

(DEFUN C:MAC (/ ENT NXT VAR)
(setq ss1 (ssadd))   ;Creates Blank Selection Set SS1
(setq ss2 (ssadd))   ;Creates Blank Selection Set SS2
(SETQ SS2 (SSGET '((0 . "INSERT")))) ;Prompts user for items to be rotated filtering for blocks only
(setq x (getstring "What Letter? ")) 
(SETQ OL (SSLENGTH SS2))  ;Determined length of SS2
(SETQ IOL 0)    ;Sets initial counter to 0
(SETQ ENT (SSNAME SS2 0))  ;Selects first entity in SS2
(SETQ NXT (ENTNEXT ENT))  ;Gets the extended entity data for ENT if it exists
(WHILE (< IOL OL)   
  (IF (/= NXT nil) (SSADD ENT SS1)) ;Adds ENT to set SS1 only if it had extended entity data AKA attributes
   (SETQ IOL (+ IOL 1))   
   (SETQ ENT (SSNAME SS2 IOL))  ;Gets next entity in SS2
   (IF (= ENT nil) (SETQ NXT nil) (SETQ NXT (ENTNEXT ENT))) ;Sets NXT to nil if there are no more entities
)
(SETQ ENT (SSNAME SS1 0))  ;Gets first entity in SS1
(SETQ I 0)    ;Sets counter to 0
(SETQ SL (SSLENGTH SS1))  ;Gets length of SS1
(WHILE (< I SL)  
       (SETQ NXT (ENTNEXT ENT))  ;Gets the extended entity data for ENT if it exists
       (SETQ VAR (ENTGET NXT))  
  (WHILE (= (CDR (ASSOC 0 VAR))
             "ATTRIB")
                  (setq stuff '((1 . x)))
                  (SETQ VAR (SUBST (cons 1 x) (ASSOC 1 VAR) VAR))
                  (ENTMOD VAR)
                  (ENTUPD ENT)
   (SETQ NXT (ENTNEXT NXT))
   (SETQ VAR (ENTGET NXT))
)
(SETQ I (+ I 1))   ;Incriments rotation While loop
(SETQ ENT (SSNAME SS1 I))  ;Gets next entity in SS1
)
)

then I have multiple attribute rotate (MAR)

(DEFUN C:MAR (/ ENT NXT VAR)
(setq ss1 (ssadd))   ;Creates Blank Selection Set SS1
(setq ss2 (ssadd))   ;Creates Blank Selection Set SS2
(SETQ SS2 (SSGET '((0 . "INSERT")))) ;Prompts user for items to be rotated filtering for blocks only
(SETQ OL (SSLENGTH SS2))  ;Determined length of SS2
(SETQ IOL 0)    ;Sets initial counter to 0
(SETQ ENT (SSNAME SS2 0))  ;Selects first entity in SS2
(SETQ NXT (ENTNEXT ENT))  ;Gets the extended entity data for ENT if it exists
(WHILE (< IOL OL)   
  (IF (/= NXT nil) (SSADD ENT SS1)) ;Adds ENT to set SS1 only if it had extended entity data AKA attributes
   (SETQ IOL (+ IOL 1))   
   (SETQ ENT (SSNAME SS2 IOL))  ;Gets next entity in SS2
   (IF (= ENT nil) (SETQ NXT nil) (SETQ NXT (ENTNEXT ENT))) ;Sets NXT to nil if there are no more entities
)
(SETQ ENT (SSNAME SS1 0))  ;Gets first entity in SS1
(SETQ I 0)    ;Sets counter to 0
(SETQ SL (SSLENGTH SS1))  ;Gets length of SS1
(WHILE (< I SL)  
       (SETQ NXT (ENTNEXT ENT))  ;Gets the extended entity data for ENT if it exists
       (SETQ VAR (ENTGET NXT))  
   (WHILE (= (CDR (ASSOC 0 VAR)) ;Actual rotation loop
             "ATTRIB")
                 (SETQ VAR
                    (SUBST '(50 . 0.0)
                         (ASSOC 50 VAR)
                         VAR
                         )
                  )
                  (ENTMOD VAR)
                  (ENTUPD ENT)
                  
   (SETQ NXT (ENTNEXT NXT))
   (SETQ VAR (ENTGET NXT))
)
(SETQ I (+ I 1))   ;Incriments rotation While loop
(SETQ ENT (SSNAME SS1 I))  ;Gets next entity in SS1
)
)

[ASMI]

There is some problems with code. Please wait...

[ASMI]

Done... Ok. This function has one argument Input_Block - Ename or VLA-Object of block with attributes an do the same as reactore above with any block. You can test it, type in command line (Rotate_and_Move_Attributes (car(entsel))) and pick any rotated block with attributes.

In your block insertion program you can use it as (Rotate_and_Move_Attributes ENT) before ending (princ).

(defun Rotate_and_Move_Attributes(Input_Block ; - block Ename or Vla-Object
				/ cBl atLst minPt maxPt
				ptLst cPt errCnt rAng mPt xPt laySt
				pLst mX mY xX xY p1 p2 p3 p4 hX hY
				sPt grDat fPt stFlag actDoc stFlag
				stopFlag *error*)

(vl-load-com)

 (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); end if
     (if
       (not
         (vl-catch-all-error-p
           (setq caArr(vl-catch-all-apply 'vlax-safearray->list
             (list
               (vlax-variant-value
                 (vla-GetConstantAttributes Block)))))))
             caArr); end if
      ); end append
    ); end asmi-GetAttributes

(defun asmi-LayersUnlock(/ restLst)
  (setq restLst '())
  (vlax-for lay(vla-get-Layers
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
         (setq restLst
           (append restLst
             (list
               (list
                 lay
                  (vla-get-Lock lay)
                 ); end list
               ); end list
             ); end append
           ); end setq
        (vla-put-Lock lay :vlax-false)
      ); end vlax-for
   restLst
  ); end of asmi-LayersUnlock

  (defun asmi-LayersStateRestore(StateList)
    (foreach lay StateList
      (vla-put-Lock(car lay)(cadr lay))
     ); end foreach
    (princ)
  ); end of asmi-LayersStateRestore

  (defun *error*(msg)
    (if stFlag
      (vla-EndUndoMark actDoc)
      ); end if
    (redraw)
    (princ(strcat "\n" msg))
    (princ)
    ); end of *error*

(if
  (and
    Input_Block
    (= "INSERT"(cdr(assoc 0(entget Input_Block))))
   ); end and
  (setq cBl(vlax-ename->vla-object Input_Block))
  (setq cBl Input_Block)
  ); end if
  
  (if
    (and
      cBl
      (= "AcDbBlockReference"(vla-get-ObjectName cBl))
      (= :vlax-true(vla-get-HasAttributes cBl))
      ); end and
    (progn
      (vla-GetBoundingBox cBl 'minPt 'maxPt)
      (setq atLst(asmi-GetAttributes cBl)
	    ptLst(mapcar 'vlax-safearray->list(list maxPt minPt))
	    cPt(vlax-3d-Point
		 (mapcar '+(cadr ptLst)
		   (mapcar '/(mapcar '-
		     (car ptLst)(cadr ptLst))'(2 2 1))))
	    rAng(vla-get-Rotation(car atLst))
	    actDoc(vla-get-ActiveDocument
		    (vlax-get-acad-object))
	    laySt(asmi-LayersUnlock)
	    ); end setq
      (setq stFlag T)
      (vla-StartUndoMark actDoc)
      (foreach att atLst
	(if(vl-catch-all-error-p
	     (vl-catch-all-apply 'vla-Rotate
	       (list att cPt (- rAng)))) nil
	  (progn
	    (vla-GetBoundingBox att 'mPt 'xPt)
	    (setq pLst
		   (append pLst
			(mapcar 'vlax-safearray->list
				      (list mPt xPt)))
		  ); end setq
	    ); end progn
	  ); end if
	); end foreach
      (setq mX(vl-sort pLst '(lambda(a b)(<(car a)(car b))))
	    mY(vl-sort pLst '(lambda(a b)(<(cadr a)(cadr b))))
	    xX(vl-sort pLst '(lambda(a b)(>(car a)(car b))))
	    xY(vl-sort pLst '(lambda(a b)(>(cadr a)(cadr b))))
	    hX(/(-(caar xX)(caar mX))2) hY(/(-(cadar xY)(cadar mY))2)
	    fPt(list(+(caar mX)hX)(+(cadar mY)hY)0.0)
	    ); end setq
      (princ "\n<<< Move attributes or Right Click to stay >>> ")
      (while(and
	      (/= 3(car(setq grDat(grread T 1))))
	      (not stopFlag)
	      ); end or
	(redraw)
	(if(= 'LIST(type(setq sPt(cadr grDat))))
	  (progn
	   (setq p1(list(-(car sPt)hX)(-(cadr sPt)hY))
	         p2(list(-(car sPt)hX)(+(cadr sPt)hY))
	         p3(list(+(car sPt)hX)(+(cadr sPt)hY))
	         p4(list(+(car sPt)hX)(-(cadr sPt)hY))
	      ); end setq
	    (grdraw p1 p2 3)(grdraw p2 p3 3)
	    (grdraw p3 p4 3)(grdraw p4 p1 3)
	   ); end progn
	     (if(= 25(car grDat))
                (setq sPt fPt
		      stopFlag T); end setq
	    ); end if
	  ); end if
	); end while
      (redraw)
      (foreach att atLst
	(if(vl-catch-all-error-p
	     (vl-catch-all-apply 'vla-Move
	       (list att(vlax-3D-point fPt)
		        (vlax-3D-point(trans sPt 1 0)))))
	  nil
	  ); end if
	); end foreach
      (if laySt(asmi-LayersStateRestore laySt))
      (vla-EndUndoMark actDoc)
      ); end progn
    ); end if
  (princ)
  ); end of Rotate_and_Move_Attributes

Good luck

[ASMI]

Code above was updated...

[MarkytheSparky]

ASMI,

OK I have the code working except when I set ATTREQ = 0

Then I get the same error as before. (Automation Error. Null extents)

(defun C:2x4 ()
 (setvar "cmdecho" 0)
 (setvar "orthomode" 1)
 (SETVAR "attreq" 0)
 (setq ds (getvar "dimscale"))
 (setq ip (getpoint "Insertion Point:"))
 (setq clay (getvar "clayer"))
  (command "-layer" "s" "E-LITE-CLNG-NEW" "")
  (command "insert" "2x4" ip "" "" pause)
  (Rotate_and_Move_Attributes (entlast))
 (setvar "clayer" clay)
 (princ)
)

[MarkytheSparky]

ASMI,

I SOLVED THE PROBLEM, BY PUTTING A DEFAULT TEXT INTO THE BLOCK.

It would be really cool if the green box would come up if the attributes were empty and let you move empty attributes - that way when you go back and insert text it will be ready to go in the correct location...

Maybe that makes sense - maybe not.

I need to work with it a little before I say for sure.

maybe I keep the default text there, use teh green box to relocate it - then use MAC command to make it empty (Erase it).

That might work.

[ASMI]

You are right it not well, I did not consider that there can be attributes with empty values. Try new function. It has 4 arguments (read header of function and exuse for may English). For example in your case you can call it as:

(Rotate_and_Move_Attributes (entlast) nil nil nil) - for default message, default string "..." for empty attributes, and stay it after insertion.

or

(Rotate_and_Move_Attributes (entlast) "\nMove & Place" "This is an empty attribute string" T) - for "Move & Place" message, "This is an empty attribute string" - temp string for empty attributes and delete it after insertion.

(defun Rotate_and_Move_Attributes(Input_Block   ; - block Ename or Vla-Object
				  
				  Message       ; - Message starts with \n, if NIL =
				                ;   "\n<<< Move attributes or Right Click to stay >>> "
				  
				  Empty_String  ; - Temp string if attribute is empty, if NIL = "..."
				  
				  Delete_Empty  ; - If T - delete temp strings after attribute movement
				  
				/ cBl atLst minPt maxPt
				ptLst cPt errCnt rAng mPt xPt laySt
				pLst mX mY xX xY p1 p2 p3 p4 hX hY
				sPt grDat fPt stFlag actDoc stFlag
				stopFlag *error*)

(vl-load-com)

 (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); end if
     (if
       (not
         (vl-catch-all-error-p
           (setq caArr(vl-catch-all-apply 'vlax-safearray->list
             (list
               (vlax-variant-value
                 (vla-GetConstantAttributes Block)))))))
             caArr); end if
      ); end append
    ); end asmi-GetAttributes

(defun asmi-LayersUnlock(/ restLst)
  (setq restLst '())
  (vlax-for lay(vla-get-Layers
     (vla-get-ActiveDocument
       (vlax-get-acad-object)))
         (setq restLst
           (append restLst
             (list
               (list
                 lay
                  (vla-get-Lock lay)
                 ); end list
               ); end list
             ); end append
           ); end setq
        (vla-put-Lock lay :vlax-false)
      ); end vlax-for
   restLst
  ); end of asmi-LayersUnlock

  (defun asmi-LayersStateRestore(StateList)
    (foreach lay StateList
      (vla-put-Lock(car lay)(cadr lay))
     ); end foreach
    (princ)
  ); end of asmi-LayersStateRestore

  (defun *error*(msg)
    (if stFlag
      (vla-EndUndoMark actDoc)
      ); end if
    (redraw)
    (princ(strcat "\n" msg))
    (princ)
    ); end of *error*

(if
  (and
    Input_Block
    (= "INSERT"(cdr(assoc 0(entget Input_Block))))
   ); end and
  (setq cBl(vlax-ename->vla-object Input_Block))
  (setq cBl Input_Block)
  ); end if
  
  (if
    (and
      cBl
      (= "AcDbBlockReference"(vla-get-ObjectName cBl))
      (= :vlax-true(vla-get-HasAttributes cBl))
      ); end and
    (progn
      (if(not Message)
	(setq Message "\n<<< Move attributes or Right Click to stay >>> ")
	); end if
      (if(not Empty_String)(setq Empty_String "..."))
      (vla-GetBoundingBox cBl 'minPt 'maxPt)
      (setq atLst(asmi-GetAttributes cBl)
	    ptLst(mapcar 'vlax-safearray->list(list maxPt minPt))
	    cPt(vlax-3d-Point
		 (mapcar '+(cadr ptLst)
		   (mapcar '/(mapcar '-
		     (car ptLst)(cadr ptLst))'(2 2 1))))
	    rAng(vla-get-Rotation(car atLst))
	    actDoc(vla-get-ActiveDocument
		    (vlax-get-acad-object))
	    laySt(asmi-LayersUnlock)
	    ); end setq
      (setq stFlag T)
      (vla-StartUndoMark actDoc)
      (foreach att atLst
	(if(= ""(vla-get-TextString att))
	  (vla-put-TextString att Empty_String)
	  ); end if
	(vla-Rotate att cPt (- rAng))
	(vla-GetBoundingBox att 'mPt 'xPt)
	(setq pLst
	     (append pLst
		  (mapcar 'vlax-safearray->list
				   (list mPt xPt)))
		  ); end setq
	); end foreach
      (setq mX(vl-sort pLst '(lambda(a b)(<(car a)(car b))))
	    mY(vl-sort pLst '(lambda(a b)(<(cadr a)(cadr b))))
	    xX(vl-sort pLst '(lambda(a b)(>(car a)(car b))))
	    xY(vl-sort pLst '(lambda(a b)(>(cadr a)(cadr b))))
	    hX(/(-(caar xX)(caar mX))2) hY(/(-(cadar xY)(cadar mY))2)
	    fPt(list(+(caar mX)hX)(+(cadar mY)hY)0.0)
	    ); end setq
      (princ Message)
      (while(and
	      (/= 3(car(setq grDat(grread T 1))))
	      (not stopFlag)
	      ); end or
	(redraw)
	(if(= 'LIST(type(setq sPt(cadr grDat))))
	  (progn
	   (setq p1(list(-(car sPt)hX)(-(cadr sPt)hY))
	         p2(list(-(car sPt)hX)(+(cadr sPt)hY))
	         p3(list(+(car sPt)hX)(+(cadr sPt)hY))
	         p4(list(+(car sPt)hX)(-(cadr sPt)hY))
	      ); end setq
	    (grdraw p1 p2 3)(grdraw p2 p3 3)
	    (grdraw p3 p4 3)(grdraw p4 p1 3)
	   ); end progn
	     (if(= 25(car grDat))
                (setq sPt fPt
		      stopFlag T); end setq
	    ); end if
	  ); end if
	); end while
      (redraw)
      (foreach att atLst
	 (vla-Move att(vlax-3D-point fPt)
		        (vlax-3D-point(trans sPt 1 0)))
	(if
	  (and
	    Delete_Empty
	    (= Empty_String(vla-get-TextString att))
	    ); end and
	  (vla-put-TextString att "")
	  ); end if
	); end foreach
      (if laySt(asmi-LayersStateRestore laySt))
      (vla-EndUndoMark actDoc)
      ); end progn
    ); end if
  (princ)
  ); end of Rotate_and_Move_Attributes

Enjoy if it's work as you want Tommorow is hard day and I can't to give time for it.

[MarkytheSparky]

Every exciting!

It works so well!

Thank you.



PS: what is your native language?