Topic: Rotate Text in SelectionSet

[HasanCAD]

I am trying to write a lisp to rotate selected objects but keep the text in the same angle

I did rotation step
But how to filter the previous selectionset to select text and mtext
Then rotate from its basepoint at opposite direction

Thanks  

Code: [Select]

(defun c:PlanRotate ( / AcObj ActDoc
    SelectoinPoint1 SelectoinPoint2 SelectionSet BasePoint RotationAngle RotationAngleDtr
    )
  (vl-load-com)

  ;Undo
  (setq AcObj (vlax-get-Acad-Object))
  (setq ActDoc (vla-get-ActiveDocument AcObj))
  (vla-EndUndoMark ActDoc)
  (vla-StartUndoMark ActDoc)

  (if
    (and
      (setq SelectoinPoint1 (getpoint "\nSpecify first corner point: "))
      (setq SelectoinPoint2 (getcorner SelectoinPoint1 "\nSpecify second corner point: "))
      (setq SelectionSet (ssget "c" SelectoinPoint1 SelectoinPoint2))
      (setq BasePoint (getpoint "\nSpecify Base Point for Rotation: "))
      (setq RotationAngle (getangle BasePoint "\nSpecify Rotation angle: "))
      (setq RotationAngleDtr (* (/ RotationAngle pi) 180.0))
      )
    (progn
      (command "_.ROTATE" SelectionSet "" BasePoint RotationAngleDtr)
      )
    (princ "\n No objects selected")
    )

  ;(foreach n '(a b c) (print n))

    
  (vla-EndUndoMark ActDoc)
  (princ)
  )
[edit:kdub]Title was 'Help with this lisp'

[David Bethel]

I'd try something like this:

Code: [Select]

(defun c:PlanRot (/ p1 p2 ss bp ra i en ed)
  (initget 1)
  (setq p1 (getpoint "\nFirst Corner:   "))
  (initget 1)
  (setq p2 (getcorner p1 "\nOpposite Corner:  "))
  (if (not (setq ss (ssget "_C" p1 p2 '((0 . "*TEXT")))))
      (progn (alert "No Text Entities Found")
             (exit)))
  (initget 1)
  (setq bp (getpoint "\nRotation Base Point:   "))
  (initget 3)
  (setq ra (getangle "\nRotation Angle:   "))
  (command "_.ROTATE" ss "" bp (/ (* ra 180.0) pi))
  (setq i -1)
  (while (setq en (ssname ss (setq i (1+ i))))
         (setq ed (entget en))
         (entmod (subst (cons 50 (- (cdr (assoc 50 ed)) ra)) (assoc 50 ed) ed)))
  (prin1))
-David

[Tharwat]

I am trying to write a lisp to rotate selected objects but keep the text in the same angle
 

Code: [Select]

(defun c:PlanRotate ( / AcObj ActDoc
     SelectoinPoint1 SelectoinPoint2 SelectionSet BasePoint RotationAngle RotationAngleDtr
     )
  (vl-load-com)

  ;Undo
  (setq AcObj (vlax-get-Acad-Object))
  (setq ActDoc (vla-get-ActiveDocument AcObj))
  [color=red](vla-EndUndoMark ActDoc)[/color]
 [color=blue] (vla-StartUndoMark ActDoc)
[/color]


End the undomark before it's going to start.  
otherwise it must be included with error trap functions.  :ugly:

Good luck with your long routine, although your idea should not include more than four or five lines of codes.

Tharwat

[David Bethel]

After rereading your OP, I'd revise it to this:

Code: [Select]

(defun c:PlanRot (/ p1 p2 ss sst bp ra i en ed)
  (while (not ss)
         (initget 1)
         (setq p1 (getpoint "\nFirst Corner:   "))
         (initget 1)
         (setq p2 (getcorner p1 "\nOpposite Corner:  "))
         (setq ss (ssget "_C" p1 p2)))
  (initget 1)
  (setq bp (getpoint "\nRotation Base Point:   "))
  (initget 3)
  (setq ra (getangle "\nRotation Angle:   "))
  (command "_.ROTATE" ss "" bp (/ (* ra 180.0) pi))
  (and (setq i -1 sst (ssget "_C" p1 p2 '((0 . "*TEXT"))))
      (while (setq en (ssname sst (setq i (1+ i))))
             (setq ed (entget en))
             (entmod (subst (cons 50 (- (cdr (assoc 50 ed)) ra)) (assoc 50 ed) ed))))
  (prin1))
-David

[CAB]

Following David's lead I would code it this way.

Code: [Select]

(defun c:PlanRot (/ ss bp ra i en ed)
  (prompt "\nSelect text to rotate.")
  (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
    (progn
      (initget 1)
      (setq bp (getpoint "\nRotation Base Point:   "))
      (initget 3)
      (setq ra (getangle bp "\nRotation Angle:   "))
      (command "_.ROTATE" ss "" bp (/ (* ra 180.0) pi))
      (setq i -1)
      (while (setq en (ssname ss (setq i (1+ i))))
        (setq ed (entget en))
        (entmod (subst (cons 50 (- (cdr (assoc 50 ed)) ra)) (assoc 50 ed) ed))
      )
    )
    (alert "No Text Entities Found")
  )
  (prin1)
)

[HasanCAD]

DAVID
CAB

Thanks

What I want is rotate selection set of objects then filter the text and rotate in opposite direction
This is revised 

Code: [Select]

;;----------------=={ Rotate plan }==-------------------------;;
;;                                                            ;;
;;  rotate all selected objected with apilaty of excuding     ;;
;;  even Text Or Blocks                                       ;;
;;------------------------------------------------------------;;
;;  Author: Hasan Mohamed Asos, 2010                          ;;
;;                                                            ;;
;;  Copyright © 2010 by Hasan, All Rights Reserved.           ;;
;;  Contact: HasanCAD @ TheSwamp.org,                         ;;
;;           Asos2000 @ CADTutor.net                          ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;                                                            ;;
;;------------------------------------------------------------;;
;;  Returns:                                                  ;;
;;                                                            ;;
;;------------------------------------------------------------;;

(defun c:PlanRotate (/ Slctd
     Slcnpt1 Slcnpt2 SlcnSetAll SlcnSetSlctd bspt RtnAngle Cntr
     SlcnSetSlctd SlcnSetSlctd2 SlcnSetSlctd3
     )

  (vl-load-com)
  ;; © Hasan Asos 2010

  (progn
    (setq AcObj (vlax-get-Acad-Object))
  (setq ActDoc (vla-get-ActiveDocument AcObj))
  (vla-EndUndoMark ActDoc)
  (vla-StartUndoMark ActDoc)
    )

  (progn
      (initget 0 "Text Blocks")
(if (> 5 (strlen (getkword "\nObjects to be executed [Text/Blocks]")))
  (setq Slctd "*TEXT")
  (setq Slctd "INSERT")
  )
)

  (if
    (and
      (setq Slcnpt1 (trans (getpoint "\nSpecify first corner point: ") 1 0))
      (setq Slcnpt2 (trans (getcorner Slcnpt1 "\nSpecify second corner point: ") 1 0))
      (setq SlcnSetAll (ssget "c" Slcnpt1 Slcnpt2))
      (setq SlcnSetSlctd (ssget "c" Slcnpt1 Slcnpt2 (List (cons 0 Slctd))))
      (setq bspt (trans (getpoint "\nSpecify Base Point for Rotation: ") 1 0))
      (setq RtnAngle (getangle bspt "\nSpecify Rotation angle: "))
      (setq Cntr -1)
      )
    (progn
      (command "_.ROTATE" SlcnSetAll "" bspt (* (/ RtnAngle pi) 180.0))
      )
    (princ "\n No objects selected")
    )

  (while (setq SlcnSetSlctd2 (ssname SlcnSetSlctd (setq Cntr (1+ Cntr))))
         (setq SlcnSetSlctd3 (entget SlcnSetSlctd2))
         (entmod (subst (cons 50 (- (cdr (assoc 50 SlcnSetSlctd3)) RtnAngle)) (assoc 50 SlcnSetSlctd3) SlcnSetSlctd3))
    )


   
  (vla-EndUndoMark ActDoc)
  (princ)
  )


[Lee Mac]

Nice code header lol  Now where have I seen that before..

[T.Willey]

I am trying to write a lisp to rotate selected objects but keep the text in the same angle
 

Code: [Select]

(defun c:PlanRotate ( / AcObj ActDoc
     SelectoinPoint1 SelectoinPoint2 SelectionSet BasePoint RotationAngle RotationAngleDtr
     )
  (vl-load-com)

  ;Undo
  (setq AcObj (vlax-get-Acad-Object))
  (setq ActDoc (vla-get-ActiveDocument AcObj))
  [color=red](vla-EndUndoMark ActDoc)[/color]
 [color=blue] (vla-StartUndoMark ActDoc)
[/color]


End the undomark before it's going to start.  
otherwise it must be included with error trap functions.  :ugly:

Good luck with your long routine, although your idea should not include more than four or five lines of codes.

Tharwat

I do this type of thing all the time.  It is in case someone left an undo mark open.

[Tharwat]

Nice code header lol   Now where have I seen that before..

Yaaa Undoubtedly copied and pasted as he used to do with a little changes to become different somehow from the following link.

Although that new user with lisp would like to become a legendary with header but without being able to write their won
codes without a help for each line.  

http://www.cadtutor.net/forum/showthread.php?48790-Upgraded-BCount

[Tharwat]

I do this type of thing all the time.  It is in case someone left an undo mark open.

I do agree but things like this with defun error.

Code: [Select]

(vl-load-com)
(defun *error* (msg)
  (vla-endundomark Mycad)
  (princ msg)
  )
....... doing of routine ....

(vla-startundomark
(setq Mycad (vla-get-activedocument (vlax-get-acad-object)))
                 )

Tharwat

[Lee Mac]

I think we discussed this recently...

My entry:

Code: [Select]

(if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-EndUndomark doc))
(vla-StartUndoMark doc)


[CAB]

DAVID
CAB

Thanks

What I want is rotate selection set of objects then filter the text and rotate in opposite direction

OH
No error checking.

Code: [Select]

(defun c:PlanRot (/ ss bp ra i en ed)
  (prompt "\nSelect objects to rotate.")
  (if (setq ss (ssget))
    (progn
      (initget 1)
      (setq bp (getpoint "\nRotation Base Point:   "))
      (initget 3)
      (setq ra (getangle bp "\nRotation Angle:   "))
      (command "_.ROTATE" ss "" bp (/ (* ra 180.0) pi))
      (setq i -1)
      (while (setq en (ssname ss (setq i (1+ i))))
        (if (vl-position (cdr (assoc 0 (setq ed (entget en)))) '("TEXT" "MTEXT"))
          (entmod (subst (cons 50 (- (cdr (assoc 50 ed)) ra)) (assoc 50 ed) ed))
        )
      )
    )
    (alert "No Text Entities Found")
  )
  (prin1)
)

[T.Willey]

I do this type of thing all the time.  It is in case someone left an undo mark open.

I do agree but things like this with defun error.

Code: [Select]

(vl-load-com)
(defun *error* (msg)
  (vla-endundomark Mycad)
  (princ msg)
  )
....... doing of routine ....

(vla-startundomark
(setq Mycad (vla-get-activedocument (vlax-get-acad-object)))
                 )

Tharwat

That only closes your undo marking.  What about other people's code?  I use code written by others in my company, an others that they farm work out to, so I just assume one is open and close it at the beginning of my code, just to make sure.

I think we discussed this recently...

My entry:

Code: [Select]

(if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-EndUndomark doc))
(vla-StartUndoMark doc)


You're correct sir.  Good alternative to just closing the mark.

[HasanCAD]

Nice code header lol  Now where have I seen that before..

eeemmmm
same is here I am wondering
Where have I seen that before

[alanjt]

I think we discussed this recently...

My entry:

Code: [Select]

(if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-EndUndomark doc))
(vla-StartUndoMark doc)


Good stuff.