Topic: Rotate routine

[Hangman]

I'm just curious, has anyone written or have a routine that rotates selected objects about their insertion point ??

Take text for example.  Say you have several pieces of text (dtext & mtext) on a plan and you need to rotate the text (currently running horizontal) to a vertical position.  But you want the text to stay in their locations.
So the insert point of the dtext selected is Left, Bottom Center, & Right.  The user would select the text entities and rotate 90 degrees ccw and the text would rotate about their insertion points the 90 degrees.

Take Blocks; rotate about the insertion point.

Take individual entities (lines, rectangles, polylines); would the user have to select a point for the object to rotate about ??

Would this be a useful tool ??   Hmmmm.

[David Hall]

I have a routine that rotates text similiar to what your asking, but in VBA

[Dinosaur]

This is one of my acquisitions dating back to r10 era.  It worked back then
ROINS.LSP

Code: [Select]

;ROINS.LSP=ROTATE BLOCK ABOUT ORIGIN

(defun rtd (ang)
(* (/ ang PI) 180.0))

(DEFUN C:ROINS  ()
(princ "PICK OBJECTS TO BE ROTATED ABOUT THEIR ORIGIN...")
(setq rotlist (ssget))
(setq rotang (rtd (getangle "ENTER ANGLE OF ROTATION...")))
(setq ctr (- (sslength rotlist) 1))
(while (> ctr -1)
(setq item (ssname rotlist ctr))
(setq iteml (entget item))
(if (= (cdr (assoc 0 iteml)) "INSERT")
(progn (setq basept (cdr (assoc 10 iteml)))
(command "ROTATE" item "" basept rotang)))
(setq ctr (1- ctr))))
(C:ROINS)



[PHX cadie]

We edited the "promptrotation>0" to 1 in all the .atc files so when the blocks from a palette are inserted the user picks the rotation, but only when the block is first inserted.

[daron]

Yes.

Code: [Select]

(defun vl-UndoBegin ()
  (vla-StartUndoMark
    (vla-get-activedocument
      (vlax-get-acad-object)
    )
  )
)
(defun vl-UndoEnd ()
  (vla-EndUndoMark
    (vla-get-activedocument
      (vlax-get-acad-object)
    )
  )
)

(defun Rotation (x)
     (vla-rotate
  x
  (vla-get-insertionpoint x)
  (- (getangle (vlax-safearray->list
    (vlax-variant-value
(vla-get-insertionpoint x)
    )
       )
       "\nRotation angle: "
     )
     (vla-get-rotation x)
  )
     )
     (princ)
)

(defun c:rtxi (/ ent)
     (vl-undobegin)
     (setq ent (vlax-ename->vla-object
    (car (nentsel "\nselect Object: "))
       )
     )
     (Rotation ent)
     (vl-undoend)
     (princ)
)
also scaling objects by reference by insertion or first point.

Code: [Select]

(defun geninfo ()
     (setq ename (ssname ss cnt)
   elist (entget ename)
   insp (cdr (assoc 10 elist))
   cnt (1+ cnt)
     ) ;_ SETQ
)

(defun c:scup ()
     (setq ss   (ssget)
   cnt   0
   curval (getreal "\nSpecify reference length <1>: ")
   newval (getreal "\nSpecify new length: ")
     ) ;_ setq
     (if (= curval nil)
  (setq curval 1.0)
     ) ;_ if
     (repeat (sslength ss)
  (geninfo)
  (command ".scale" ename "" insp "R" curval newval)
     ) ;_ REPEAT
     (princ)
) ;_ defun

[David Hall]

This rotates text for an isometric drawing, but it gives you the idea

Code: [Select]

Public Sub fixtop30()
Dim objSelected As Object
Dim objSelSet As AcadSelectionSet
Dim N As Integer
Dim objTxt As AcadText
On Error Resume Next
    If ThisDrawing.SelectionSets.Count > 0 Then
        For N = 0 To ThisDrawing.SelectionSets.Count - 1
            If ThisDrawing.SelectionSets.Item(N).Name = "Isotext" Then
            ThisDrawing.SelectionSets("Isotext").Delete
            End If
        Next N
    End If
Set objSelSet = ThisDrawing.SelectionSets.Add("Isotext")
objSelSet.SelectOnScreen
    For Each objSelected In objSelSet
        If TypeOf objSelected Is AcadText Then
        Set objTxt = objSelected
        objTxt.Rotation = 0.523599
        objTxt.ObliqueAngle = 5.75959
        End If
    Next
ThisDrawing.Application.Update
'Exit_Here:
Exit Sub
End Sub

[Patrick_35]

Yes.
An another with reactor
The first for all attibutes
http://carnet-de-cablage.chez-alice.fr/Lisp/Rot_0.lsp
The second just for one bloc and their attributes
http://carnet-de-cablage.chez-alice.fr/Lisp/Rot.lsp

@+