rotate objects to 0°

[gringooo]

hello,

i need a lisp to rotate selected objects very quick to 0°.

maybe with selection of two points and the first point is the base of the rotation.

Or the lisp do it automaticly with no points selction. Maybe it will get the rotation angle from 2 points of the object with the max distance to each other. after that gets the the two minimum Y points to turn it to 0°.

at the moment i rotate each object with the reference option, and that take much more time.

i searched in the forum for a lisp like this but found nothing.

please help me, i have thoasands of objects to turn...

MANY THANKS!

before

after rotation to 0°

[ВeekeeCZ]

Hi gringooo,
You gonna need post dwg with samples of all kinds of objects which you need to turn. We need to find some pattern... see what entities...

[regisrohde]

IF BLOCKS FOR THE CODE BELOW MUST SOLVE

(defun c:RBLO (/ entidade ename entdados ponto3d ang0 ang1 ed)
(setq entidade (entsel "\n SELECT BLOCK"))
(setq ename (car entidade))
(setq entdados (entget (car entidade)))
(setq PONTO3D (CDR (assoc 10 entdados)))
(princ ponto3d)
(setq ang0 (CDR (assoc 50 entdados)))
;ANGLE
(SETQ ANG1 0)
(setq ed entdados)
(setq ed (subst (cons 50 ang1) (assoc 50 ed) ed ))
(entmod ed)
)

[Kent1Cooper]

---

@gringooo wrote:

.... 

i need a lisp to rotate selected objects very quick to 0°.

.... 

at the moment i rotate each object with the reference option, and that take much more time.

....

---

In addition to that, look into the ALIGN command.  It can also move something to where you want it, in the process of rotating it.

For the possibility of a routine to calculate points and determine which are farthest apart and/or closest together:  What kinds of object(s) are you talking about?  Something could do that for a Polyline easily enough, but if Text is added to the selection, things get complicated.  If it's a Block, I'm not sure it's possible to determine such things, but it may be.

[gringooo]

Hi,

thanks for answers! 

@ВeekeeCZ

thanks, here a sample dwg!

@regisrohde

to make a block for each object is much work...

i tried your code, but it don't work alltough i make a block of the objects

@Kent1Cooper

align is a good tip, but also much of clicks, but faster then manual rotate!

hope you guy's can share a automatic lisp routine.

the objects are polylines and circles, no text (the text is exploeded to polylines).

i would prefer a group for all objects.

so the lisp will select a group, if possible,

or maybe even the lisp can select much off groups per selection and rotate each one. rotate center maybe the center of each group. 🙂

thanks!

[Kent1Cooper]

---

@Anonymous wrote:

IF BLOCKS FOR THE CODE BELOW MUST SOLVE

....

---

If  [and I think it's a big if ] the object in question is, in fact, a Block, and its base definition is horizontal so that a rotation of 0 is what is needed, that can be done much more concisely, in part by omitting several unnecessary or never-used variables, for example:

(defun C:B0 (/ bdata); = Block to 0 rotation
  (setq bdata (entget (car (entsel "\nSelect Block for 0 rotation: "))))
  (entmod (subst '(50 . 0) (assoc 50 bdata) bdata))
)

or:

(vl-load-com); [if needed]
(defun C:B0 (/ blkobj)
  (setq blkobj (vlax-ename->vla-object (car (entsel "\nSelect Block for 0 rotation: "))))
  (vla-put-Rotation blkobj 0)
)

[Both could use more in the way of object-selection verification, etc., but so could regisrohde's version.  If there's some reason to, either could add his reporting of the insertion point.]

It can also be done without any routine, by simply picking the Block and giving it 0 rotation in the Properties box.  I always have the Properties box up, as narrow as I can work with along the edge of the screen, in which case that approach takes no more steps [pick the Block, assign the rotation] than such a defined routine would [type the command name or pick a menu item, pick the Block], so defining a routine for this wouldn't gain anything in my situation.

But I'm still interested in what kind(s) of object(s) the OP is really working with.

[Kent1Cooper]

---

@gringooo wrote:

.... here a sample dwg!

.... 

---

Would they always be in this kind of configuration, with a LWPolyline outline in a very shallow arc shape, and all the Circles and 2D-Polyline text pieces inside it?  If so, it may be achievable, with a single LWPolyline being the only part that needs to be considered to determine the rotation.

It would be a lot simpler if those Polyline outlines had only four vertices at the corners, with single-arc-segment curved edges, instead of having thosc edges subdivided into so many segments.  But using the coordinates of the bounding box, it should be possible to determine which vertices are at the corners, though there might be some difficulty if the amount of curvature and/or the initial rotation is such that any edge(s) of the bounding box is/are defined by some place on the outer curve not at a corner.

The determination of the direction between corners that you want to take to 0 degrees would actually not always be between the two corners that are farthest apart, as I first assumed.  In your lower examples, those would be one on the outer edge and the one at the opposite end of the inner edge.  So it would be important to know the extremes in the range of possible shapes.

[hmsilva · Accepted solution]

Hi gringoo,

quick and dirty, and using Lee Mac's Minimum Bounding Box

(vl-load-com)
;; Minimum Bounding Box  -  Lee Mac
;; Returns the WCS coordinates describing the minimum bounding rectangle
;; surrounding all objects in a supplied selection set.
;; sel - [sel] selection set to process
;; tol - [rea] precision of calculation, 0 < tol < 1

(defun LM:minboundingbox (sel tol / ang box bx1 bx2 cen idx lst obj rtn)
    (if (and sel (< 0.0 tol 1.0))
        (progn
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (and (vlax-method-applicable-p obj 'getboundingbox)
                         (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
                    )
                    (setq lst (cons (vla-copy obj) lst))
                )
            )
            (if lst
                (progn
                    (setq box (LM:objlstboundingbox lst)
                          tol (* tol pi)
                          cen (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.0)) box))
                          bx1 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                          rtn (list 0.0 box)
                          ang 0.0
                    )
                    (while (< (setq ang (+ ang tol)) pi)
                        (foreach obj lst (vlax-invoke obj 'rotate cen tol))
                        (setq box (LM:objlstboundingbox lst)
                              bx2 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                        )
                        (if (< bx2 bx1)
                            (setq bx1 bx2
                                  rtn (list ang box)
                            )
                        )
                    )
                    (foreach obj lst (vla-delete obj))
                    (LM:rotatepoints
                        (mapcar '(lambda (a) (mapcar '(lambda (b) (apply b (cdr rtn))) a))
                                '(
                                  (caar cadar)
                                  (caadr cadar)
                                  (caadr cadadr)
                                  (caar cadadr)
                                 )
                        )
                        cen
                        (- (car rtn))
                    )
                )
            )
        )
    )
)

;; Object List Bounding Box  -  Lee Mac
;; Returns the lower-left and upper-right points of a rectangle bounding a list of objects

(defun LM:objlstboundingbox (lst / llp ls1 ls2 urp)
    (foreach obj lst
        (vla-getboundingbox obj 'llp 'urp)
        (setq ls1 (cons (vlax-safearray->list llp) ls1)
              ls2 (cons (vlax-safearray->list urp) ls2)
        )
    )
    (mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)

;; Rotate Points  -  Lee Mac
;; Rotates a list of points about a supplied point by a given angle

(defun LM:rotatepoints (lst bpt ang / mat vec)
    (setq mat
             (list
                 (list (cos ang) (sin (- ang)) 0.0)
                 (list (sin ang) (cos ang) 0.0)
                 '(0.0 0.0 1.0)
             )
    )
    (setq vec (mapcar '- bpt (mxv mat bpt)))
    (mapcar '(lambda (x) (mapcar '+ (mxv mat x) vec)) lst)
)

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv (m v)
    (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)



(defun c:demo (/ a b lst sel)
    (if (setq sel (ssget "_:L"))
        (progn
            (setq lst (LM:minboundingbox sel 0.01))
            (if (> (distance (nth 0 lst)(nth 3 lst)) (distance (nth 0 lst)(nth 1 lst)))
                (setq a (nth 0 lst) b (nth 3 lst))
                (setq a (nth 0 lst) b (nth 1 lst))
                )
            (command "_rotate"
                     sel
                     ""
                     "_NON"
                     a
                     "_R"
                     "@"
                     "_NON"
                     b
                     "_NON"
                     (polar a 0.0 (distance a b))
            )
        )
    )
    (princ)
)

Hope this helps,
Henrique

[ВeekeeCZ]

It's always good to know what Lee has 🙂
Little improvement... since the OP has thousands of those... may come in handy.

Spoiler

(vl-load-com)
;; Minimum Bounding Box  -  Lee Mac
;; Returns the WCS coordinates describing the minimum bounding rectangle
;; surrounding all objects in a supplied selection set.
;; sel - [sel] selection set to process
;; tol - [rea] precision of calculation, 0 < tol < 1

(defun LM:minboundingbox (sel tol / ang box bx1 bx2 cen idx lst obj rtn)
    (if (and sel (< 0.0 tol 1.0))
        (progn
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (and (vlax-method-applicable-p obj 'getboundingbox)
                         (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
                    )
                    (setq lst (cons (vla-copy obj) lst))
                )
            )
            (if lst
                (progn
                    (setq box (LM:objlstboundingbox lst)
                          tol (* tol pi)
                          cen (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.0)) box))
                          bx1 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                          rtn (list 0.0 box)
                          ang 0.0
                    )
                    (while (< (setq ang (+ ang tol)) pi)
                        (foreach obj lst (vlax-invoke obj 'rotate cen tol))
                        (setq box (LM:objlstboundingbox lst)
                              bx2 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                        )
                        (if (< bx2 bx1)
                            (setq bx1 bx2
                                  rtn (list ang box)
                            )
                        )
                    )
                    (foreach obj lst (vla-delete obj))
                    (LM:rotatepoints
                        (mapcar '(lambda (a) (mapcar '(lambda (b) (apply b (cdr rtn))) a))
                                '(
                                  (caar cadar)
                                  (caadr cadar)
                                  (caadr cadadr)
                                  (caar cadadr)
                                 )
                        )
                        cen
                        (- (car rtn))
                    )
                )
            )
        )
    )
)

;; Object List Bounding Box  -  Lee Mac
;; Returns the lower-left and upper-right points of a rectangle bounding a list of objects

(defun LM:objlstboundingbox (lst / llp ls1 ls2 urp)
    (foreach obj lst
        (vla-getboundingbox obj 'llp 'urp)
        (setq ls1 (cons (vlax-safearray->list llp) ls1)
              ls2 (cons (vlax-safearray->list urp) ls2)
        )
    )
    (mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)

;; Rotate Points  -  Lee Mac
;; Rotates a list of points about a supplied point by a given angle

(defun LM:rotatepoints (lst bpt ang / mat vec)
    (setq mat
             (list
                 (list (cos ang) (sin (- ang)) 0.0)
                 (list (sin ang) (cos ang) 0.0)
                 '(0.0 0.0 1.0)
             )
    )
    (setq vec (mapcar '- bpt (mxv mat bpt)))
    (mapcar '(lambda (x) (mapcar '+ (mxv mat x) vec)) lst)
)

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv (m v)
    (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)


(defun c:demo (/ a adoc b lst ss sel i)

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  
  (if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE")(8 . "_V_FRAESEN"))))
    (repeat (setq i (sslength ss))
      (if (and (setq lst (LM:minboundingbox (ssadd (ssname ss (setq i (1- i)))) 0.01))
	       (setq sel (ssget "_CP" lst))
	       )
	(progn
	  (if (> (distance (nth 0 lst)(nth 3 lst)) (distance (nth 0 lst)(nth 1 lst)))
	    (setq a (nth 0 lst) b (nth 3 lst))
	    (setq a (nth 0 lst) b (nth 1 lst)))
	  (command "_rotate"
		   sel
		   ""
		   "_NON"
		   a
		   "_R"
		   "@"
		   "_NON"
		   b
		   "_NON"
		   (polar a 0.0 (distance a b))
		   )
	  ))))
  (vla-endundomark adoc)
  (princ)
)

[hmsilva]

---

@ВeekeeCZ wrote:

It's alway good to know what Lee has 🙂

---

True! 🙂

I recall a similar routine from Kent1Cooper (sorry Kent, but I was not been able to find it...)

Henrique

[gringooo]

---

@Kent1Cooper wrote:

Would they always be in this kind of configuration, with a LWPolyline outline in a very shallow arc shape, and all the Circles and 2D-Polyline text pieces inside it?

yes! 🙂

@hmsilva

amazing! works realy great! thanks for that solution! quick and dirty 

 do you think it would be possible to select much of groups, and all of the groups turns to "0" around there center? 

anyway, great work, many thanks! it helps a lot! 

[ВeekeeCZ]

Ok... added little more of Lee's work... 🙂 ...now it groups ents as well.

Spoiler

(vl-load-com)
;; Minimum Bounding Box  -  Lee Mac
;; Returns the WCS coordinates describing the minimum bounding rectangle
;; surrounding all objects in a supplied selection set.
;; sel - [sel] selection set to process
;; tol - [rea] precision of calculation, 0 < tol < 1

(defun LM:minboundingbox (sel tol / ang box bx1 bx2 cen idx lst obj rtn)
    (if (and sel (< 0.0 tol 1.0))
        (progn
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (and (vlax-method-applicable-p obj 'getboundingbox)
                         (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
                    )
                    (setq lst (cons (vla-copy obj) lst))
                )
            )
            (if lst
                (progn
                    (setq box (LM:objlstboundingbox lst)
                          tol (* tol pi)
                          cen (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.0)) box))
                          bx1 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                          rtn (list 0.0 box)
                          ang 0.0
                    )
                    (while (< (setq ang (+ ang tol)) pi)
                        (foreach obj lst (vlax-invoke obj 'rotate cen tol))
                        (setq box (LM:objlstboundingbox lst)
                              bx2 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                        )
                        (if (< bx2 bx1)
                            (setq bx1 bx2
                                  rtn (list ang box)
                            )
                        )
                    )
                    (foreach obj lst (vla-delete obj))
                    (LM:rotatepoints
                        (mapcar '(lambda (a) (mapcar '(lambda (b) (apply b (cdr rtn))) a))
                                '(
                                  (caar cadar)
                                  (caadr cadar)
                                  (caadr cadadr)
                                  (caar cadadr)
                                 )
                        )
                        cen
                        (- (car rtn))
                    )
                )
            )
        )
    )
)

;; Object List Bounding Box  -  Lee Mac
;; Returns the lower-left and upper-right points of a rectangle bounding a list of objects

(defun LM:objlstboundingbox (lst / llp ls1 ls2 urp)
    (foreach obj lst
        (vla-getboundingbox obj 'llp 'urp)
        (setq ls1 (cons (vlax-safearray->list llp) ls1)
              ls2 (cons (vlax-safearray->list urp) ls2)
        )
    )
    (mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)

;; Rotate Points  -  Lee Mac
;; Rotates a list of points about a supplied point by a given angle

(defun LM:rotatepoints (lst bpt ang / mat vec)
    (setq mat
             (list
                 (list (cos ang) (sin (- ang)) 0.0)
                 (list (sin ang) (cos ang) 0.0)
                 '(0.0 0.0 1.0)
             )
    )
    (setq vec (mapcar '- bpt (mxv mat bpt)))
    (mapcar '(lambda (x) (mapcar '+ (mxv mat x) vec)) lst)
)

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv (m v)
    (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)

(defun anonymousgroup (ss / l )
  (vl-load-com)
  ;; © Lee Mac 2010

  (if (setq l (LM:SS->VLA ss))
    (vla-AppendItems
      (vla-Add
        (vla-get-Groups
          (vla-get-ActiveDocument
            (vlax-get-acad-object)
          )
        )
        "*"
      )
      (LM:ObjectVariant l)
    )
  )
  (princ)
)


;;------------------=={ Safearray Variant }==-----------------;;
;;                                                            ;;
;;  Creates a populated Safearray Variant of a specified      ;;
;;  data type                                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  datatype - variant type enum (eg vlax-vbDouble)           ;;
;;  data     - list of static type data                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Variant Object of type specified            ;;
;;------------------------------------------------------------;;

(defun LM:SafearrayVariant ( datatype data )
  ;; © Lee Mac 2010
  (vlax-make-variant
    (vlax-safearray-fill
      (vlax-make-safearray datatype
        (cons 0 (1- (length data)))
      )
      data
    )    
  )
)

;;-------------------=={ Object Variant }==-------------------;;
;;                                                            ;;
;;  Creates a populated Object Variant                        ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst - list of VLA Objects to populate the Variant.        ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Object Variant                              ;;
;;------------------------------------------------------------;;

(defun LM:ObjectVariant ( lst )
  ;; © Lee Mac 2010
  (LM:SafearrayVariant vlax-vbobject lst)
)

;;-----------------=={ SelectionSet -> VLA }==----------------;;
;;                                                            ;;
;;  Converts a SelectionSet to a list of VLA Objects          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - Valid SelectionSet (Pickset)                         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of VLA Objects                             ;;
;;------------------------------------------------------------;;

(defun LM:ss->vla ( ss )
  ;; © Lee Mac 2010
  (if ss
    (
      (lambda ( i / e l )
        (while (setq e (ssname ss (setq i (1+ i))))
          (setq l (cons (vlax-ename->vla-object e) l))
        )
        l
      )
      -1
    )
  )
)



(defun c:demo (/ a adoc b lst ss sel i)

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  
  (if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE")(8 . "_V_FRAESEN"))))
    (repeat (setq i (sslength ss))
      (if (and (setq lst (LM:minboundingbox (ssadd (ssname ss (setq i (1- i)))) 0.01))
	       (setq sel (ssget "_CP" lst))
	       )
	(progn
	  (if (> (distance (nth 0 lst)(nth 3 lst)) (distance (nth 0 lst)(nth 1 lst)))
	    (setq a (nth 0 lst) b (nth 3 lst))
	    (setq a (nth 0 lst) b (nth 1 lst)))
	  (command "_rotate"
		   sel
		   ""
		   "_NON"
		   a
		   "_R"
		   "@"
		   "_NON"
		   b
		   "_NON"
		   (polar a 0.0 (distance a b))
		   )
	  (anonymousgroup sel)
	  ))))
  (vla-endundomark adoc)
  (princ)
)

[Kent1Cooper]

---

@hmsilva wrote:

....

I recall a similar routine from Kent1Cooper (sorry Kent, but I was not been able to find it...)

.... 

---

It's SmallestRectangle.lsp with its SR command, here.  I might have suggested it before, but it gets only as close as the stepping increment [1 degree as written, but refinable], so whether it's good for the OP's purpose depends on how precisely they want the 0-degree direction between corners.  And of course it would need to be followed up by a Rotation command using the corners of the resulting rectangle, or perhaps could be adjusted to leave the selected objects at that smallest-bounding-box orientation rather than drawing the rectangle.

[hmsilva]

---

@Kent1Cooper wrote:
It's SmallestRectangle.lsp with its SR command, here.  I might have suggested it before, but it gets only as close as the stepping increment [1 degree as written, but refinable], so whether it's good for the OP's purpose depends on how precisely they want the 0-degree direction between corners.  And of course it would need to be followed up by a Rotation command using the corners of the resulting rectangle, or perhaps could be adjusted to leave the selected objects at that smallest-bounding-box orientation rather than drawing the rectangle.

---

Yes, it was the SmallestRectangle.lsp!

---

@gringooo wrote:

@hmsilva

 do you think it would be possible to select much of groups, and all of the groups turns to "0" around there center?...

---

@gringooo

BeeheeCZ's code in message #12 already does that, except 'turns to "0" around there center', to do that, change

(if (> (distance (nth 0 lst)(nth 3 lst)) (distance (nth 0 lst)(nth 1 lst)))
	    (setq a (nth 0 lst) b (nth 3 lst))
	    (setq a (nth 0 lst) b (nth 1 lst)))

to

(if (> (distance (nth 0 lst)(nth 3 lst)) (distance (nth 0 lst)(nth 1 lst)))
                (setq a (mapcar '(lambda (a b) (/ (+ a b) 2)) (nth 0 lst) (nth 2 lst)) b (mapcar '(lambda (a b) (/ (+ a b) 2)) (nth 2 lst) (nth 3 lst)))
                (setq a (mapcar '(lambda (a b) (/ (+ a b) 2)) (nth 0 lst) (nth 2 lst)) b (mapcar '(lambda (a b) (/ (+ a b) 2)) (nth 1 lst) (nth 2 lst)))
                )

Untested!!!

Hope this helps,
Henrique

[gringooo]

it works! you guys are incredible! 

one thing:

i take BeekeeCZ's code and Henrique's addition and it works , but only correctly if the groups don`t touch each other.

is it possible the groups can touch each other and the routine works as well?

Spoiler

(vl-load-com)
;; Minimum Bounding Box  -  Lee Mac
;; Returns the WCS coordinates describing the minimum bounding rectangle
;; surrounding all objects in a supplied selection set.
;; sel - [sel] selection set to process
;; tol - [rea] precision of calculation, 0 < tol < 1

(defun LM:minboundingbox (sel tol / ang box bx1 bx2 cen idx lst obj rtn)
    (if (and sel (< 0.0 tol 1.0))
        (progn
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (and (vlax-method-applicable-p obj 'getboundingbox)
                         (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
                    )
                    (setq lst (cons (vla-copy obj) lst))
                )
            )
            (if lst
                (progn
                    (setq box (LM:objlstboundingbox lst)
                          tol (* tol pi)
                          cen (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.0)) box))
                          bx1 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                          rtn (list 0.0 box)
                          ang 0.0
                    )
                    (while (< (setq ang (+ ang tol)) pi)
                        (foreach obj lst (vlax-invoke obj 'rotate cen tol))
                        (setq box (LM:objlstboundingbox lst)
                              bx2 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                        )
                        (if (< bx2 bx1)
                            (setq bx1 bx2
                                  rtn (list ang box)
                            )
                        )
                    )
                    (foreach obj lst (vla-delete obj))
                    (LM:rotatepoints
                        (mapcar '(lambda (a) (mapcar '(lambda (b) (apply b (cdr rtn))) a))
                                '(
                                  (caar cadar)
                                  (caadr cadar)
                                  (caadr cadadr)
                                  (caar cadadr)
                                 )
                        )
                        cen
                        (- (car rtn))
                    )
                )
            )
        )
    )
)

;; Object List Bounding Box  -  Lee Mac
;; Returns the lower-left and upper-right points of a rectangle bounding a list of objects

(defun LM:objlstboundingbox (lst / llp ls1 ls2 urp)
    (foreach obj lst
        (vla-getboundingbox obj 'llp 'urp)
        (setq ls1 (cons (vlax-safearray->list llp) ls1)
              ls2 (cons (vlax-safearray->list urp) ls2)
        )
    )
    (mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)

;; Rotate Points  -  Lee Mac
;; Rotates a list of points about a supplied point by a given angle

(defun LM:rotatepoints (lst bpt ang / mat vec)
    (setq mat
             (list
                 (list (cos ang) (sin (- ang)) 0.0)
                 (list (sin ang) (cos ang) 0.0)
                 '(0.0 0.0 1.0)
             )
    )
    (setq vec (mapcar '- bpt (mxv mat bpt)))
    (mapcar '(lambda (x) (mapcar '+ (mxv mat x) vec)) lst)
)

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv (m v)
    (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)

(defun anonymousgroup (ss / l )
  (vl-load-com)
  ;; © Lee Mac 2010

  (if (setq l (LM:SS->VLA ss))
    (vla-AppendItems
      (vla-Add
        (vla-get-Groups
          (vla-get-ActiveDocument
            (vlax-get-acad-object)
          )
        )
        "*"
      )
      (LM:ObjectVariant l)
    )
  )
  (princ)
)


;;------------------=={ Safearray Variant }==-----------------;;
;;                                                            ;;
;;  Creates a populated Safearray Variant of a specified      ;;
;;  data type                                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  datatype - variant type enum (eg vlax-vbDouble)           ;;
;;  data     - list of static type data                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Variant Object of type specified            ;;
;;------------------------------------------------------------;;

(defun LM:SafearrayVariant ( datatype data )
  ;; © Lee Mac 2010
  (vlax-make-variant
    (vlax-safearray-fill
      (vlax-make-safearray datatype
        (cons 0 (1- (length data)))
      )
      data
    )    
  )
)

;;-------------------=={ Object Variant }==-------------------;;
;;                                                            ;;
;;  Creates a populated Object Variant                        ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst - list of VLA Objects to populate the Variant.        ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Object Variant                              ;;
;;------------------------------------------------------------;;

(defun LM:ObjectVariant ( lst )
  ;; © Lee Mac 2010
  (LM:SafearrayVariant vlax-vbobject lst)
)

;;-----------------=={ SelectionSet -> VLA }==----------------;;
;;                                                            ;;
;;  Converts a SelectionSet to a list of VLA Objects          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - Valid SelectionSet (Pickset)                         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of VLA Objects                             ;;
;;------------------------------------------------------------;;

(defun LM:ss->vla ( ss )
  ;; © Lee Mac 2010
  (if ss
    (
      (lambda ( i / e l )
        (while (setq e (ssname ss (setq i (1+ i))))
          (setq l (cons (vlax-ename->vla-object e) l))
        )
        l
      )
      -1
    )
  )
)



(defun c:demo (/ a adoc b lst ss sel i)

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  
  (if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE")(8 . "_V_FRAESEN"))))
    (repeat (setq i (sslength ss))
      (if (and (setq lst (LM:minboundingbox (ssadd (ssname ss (setq i (1- i)))) 0.01))
	       (setq sel (ssget "_CP" lst))
	       )
	(progn
	  (if (> (distance (nth 0 lst)(nth 3 lst)) (distance (nth 0 lst)(nth 1 lst)))
                (setq a (mapcar '(lambda (a b) (/ (+ a b) 2)) (nth 0 lst) (nth 2 lst)) b (mapcar '(lambda (a b) (/ (+ a b) 2)) (nth 2 lst) (nth 3 lst)))
                (setq a (mapcar '(lambda (a b) (/ (+ a b) 2)) (nth 0 lst) (nth 2 lst)) b (mapcar '(lambda (a b) (/ (+ a b) 2)) (nth 1 lst) (nth 2 lst)))
                )
	  (command "_rotate"
		   sel
		   ""
		   "_NON"
		   a
		   "_R"
		   "@"
		   "_NON"
		   b
		   "_NON"
		   (polar a 0.0 (distance a b))
		   )
	  (anonymousgroup sel)
	  ))))
  (vla-endundomark adoc)
  (princ)
)

see pic and dwg file.

[hmsilva]

---

@gringooo wrote:

...

one thing:

i take BeekeeCZ's code and Henrique's addition and it works , but only correctly if the groups don`t touch each other.

is it possible the groups can touch each other and the routine works as well?

---

Yes, it should be possible, but with a different approach, not using (ssget "_CP" lst)) and only for groups...

If I have some free time during the weekend, I'll see what I can do.

Henrique

[ВeekeeCZ · Accepted solution]

---

@hmsilva wrote:

---

@gringooo wrote:

...

one thing:

i take BeekeeCZ's code and Henrique's addition and it works , but only correctly if the groups don`t touch each other.

is it possible the groups can touch each other and the routine works as well?

---

Yes, it should be possible, but with a different approach, not using (ssget "_CP" lst)) and only for groups...

If I have some free time during the weekend, I'll see what I can do.

Henrique

---

Yes, I would replace _CP with _WP... it could make a difference 🙂 ... I know still not perfect.

Spoiler

(vl-load-com)
;; Minimum Bounding Box  -  Lee Mac
;; Returns the WCS coordinates describing the minimum bounding rectangle
;; surrounding all objects in a supplied selection set.
;; sel - [sel] selection set to process
;; tol - [rea] precision of calculation, 0 < tol < 1

(defun LM:minboundingbox (sel tol / ang box bx1 bx2 cen idx lst obj rtn)
    (if (and sel (< 0.0 tol 1.0))
        (progn
            (repeat (setq idx (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                (if (and (vlax-method-applicable-p obj 'getboundingbox)
                         (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
                    )
                    (setq lst (cons (vla-copy obj) lst))
                )
            )
            (if lst
                (progn
                    (setq box (LM:objlstboundingbox lst)
                          tol (* tol pi)
                          cen (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.0)) box))
                          bx1 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                          rtn (list 0.0 box)
                          ang 0.0
                    )
                    (while (< (setq ang (+ ang tol)) pi)
                        (foreach obj lst (vlax-invoke obj 'rotate cen tol))
                        (setq box (LM:objlstboundingbox lst)
                              bx2 (* (- (caadr box) (caar box)) (- (cadadr box) (cadar box)))
                        )
                        (if (< bx2 bx1)
                            (setq bx1 bx2
                                  rtn (list ang box)
                            )
                        )
                    )
                    (foreach obj lst (vla-delete obj))
                    (LM:rotatepoints
                        (mapcar '(lambda (a) (mapcar '(lambda (b) (apply b (cdr rtn))) a))
                                '(
                                  (caar cadar)
                                  (caadr cadar)
                                  (caadr cadadr)
                                  (caar cadadr)
                                 )
                        )
                        cen
                        (- (car rtn))
                    )
                )
            )
        )
    )
)

;; Object List Bounding Box  -  Lee Mac
;; Returns the lower-left and upper-right points of a rectangle bounding a list of objects

(defun LM:objlstboundingbox (lst / llp ls1 ls2 urp)
    (foreach obj lst
        (vla-getboundingbox obj 'llp 'urp)
        (setq ls1 (cons (vlax-safearray->list llp) ls1)
              ls2 (cons (vlax-safearray->list urp) ls2)
        )
    )
    (mapcar '(lambda (a b) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)

;; Rotate Points  -  Lee Mac
;; Rotates a list of points about a supplied point by a given angle

(defun LM:rotatepoints (lst bpt ang / mat vec)
    (setq mat
             (list
                 (list (cos ang) (sin (- ang)) 0.0)
                 (list (sin ang) (cos ang) 0.0)
                 '(0.0 0.0 1.0)
             )
    )
    (setq vec (mapcar '- bpt (mxv mat bpt)))
    (mapcar '(lambda (x) (mapcar '+ (mxv mat x) vec)) lst)
)

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv (m v)
    (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)

(defun anonymousgroup (ss / l )
  (vl-load-com)
  ;; © Lee Mac 2010

  (if (setq l (LM:SS->VLA ss))
    (vla-AppendItems
      (vla-Add
        (vla-get-Groups
          (vla-get-ActiveDocument
            (vlax-get-acad-object)
          )
        )
        "*"
      )
      (LM:ObjectVariant l)
    )
  )
  (princ)
)


;;------------------=={ Safearray Variant }==-----------------;;
;;                                                            ;;
;;  Creates a populated Safearray Variant of a specified      ;;
;;  data type                                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  datatype - variant type enum (eg vlax-vbDouble)           ;;
;;  data     - list of static type data                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Variant Object of type specified            ;;
;;------------------------------------------------------------;;

(defun LM:SafearrayVariant ( datatype data )
  ;; © Lee Mac 2010
  (vlax-make-variant
    (vlax-safearray-fill
      (vlax-make-safearray datatype
        (cons 0 (1- (length data)))
      )
      data
    )    
  )
)

;;-------------------=={ Object Variant }==-------------------;;
;;                                                            ;;
;;  Creates a populated Object Variant                        ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst - list of VLA Objects to populate the Variant.        ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Object Variant                              ;;
;;------------------------------------------------------------;;

(defun LM:ObjectVariant ( lst )
  ;; © Lee Mac 2010
  (LM:SafearrayVariant vlax-vbobject lst)
)

;;-----------------=={ SelectionSet -> VLA }==----------------;;
;;                                                            ;;
;;  Converts a SelectionSet to a list of VLA Objects          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss - Valid SelectionSet (Pickset)                         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of VLA Objects                             ;;
;;------------------------------------------------------------;;

(defun LM:ss->vla ( ss )
  ;; © Lee Mac 2010
  (if ss
    (
      (lambda ( i / e l )
        (while (setq e (ssname ss (setq i (1+ i))))
          (setq l (cons (vlax-ename->vla-object e) l))
        )
        l
      )
      -1
    )
  )
)



(defun c:demo (/ a adoc b lst sss ss sel i)
  
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  
  (if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE")(8 . "_V_FRAESEN"))))
    (progn
      (repeat (setq i (sslength ss))
	(if (and (setq lst (LM:minboundingbox (ssadd (ssname ss (setq i (1- i)))) 0.01))
		 (setq sel (ssget "_WP" lst))
		 )
	  (setq sss (cons (cons (ssadd (ssname ss i) sel)  lst) sss))))
      (repeat (length sss)
	(setq sel (car (nth 0 sss))
	      lst (cdr (nth 0 sss))
	      sss (cdr sss))
	(if (> (distance (nth 0 lst)(nth 3 lst)) (distance (nth 0 lst)(nth 1 lst)))
	  (setq a (mapcar '(lambda (a b) (/ (+ a b) 2)) (nth 0 lst) (nth 2 lst)) b (mapcar '(lambda (a b) (/ (+ a b) 2)) (nth 2 lst) (nth 3 lst)))
	  
	  (setq a (mapcar '(lambda (a b) (/ (+ a b) 2)) (nth 0 lst) (nth 2 lst)) b (mapcar '(lambda (a b) (/ (+ a b) 2)) (nth 1 lst) (nth 2 lst)))
	  )
	(command "_rotate"
		 sel
		 ""
		 "_NON"
		 a
		 "_R"
		 "@"
		 "_NON"
		 b
		 "_NON"
		 (polar a 0.0 (distance a b))
		 )
	(anonymousgroup sel)
	)))
  (vla-endundomark adoc)
  (princ)
)

Edit: One more improvement.

[marko_ribar]

FWIW. - check this faster and preciser version of MinimumEnclosingRectangle for 2d entities posted here... (you have to have www.theswamp.org membership to access the page)... And if I may conclude - you may never know what bonding rectangle you want to use for rotation - is it MinimumEnclosing or MaximumEncosing - my code draws both of those variants and if I may suggest - you can then manually use align command depending on rectangle you want to use... So there is no quick way if you want to automate - you have to decide and that's what isn't possible to automate... Another thing which you have to use and it's also non-automatic process is to decide which point should be base for rotation - is it mid point between bonding boxes ends or is it actually somewhere totally indepedable of any known reference obtained data... So I suggest my version of lisp and happy hours in working manulally in CAD...

Regards, Marko R.

[gringooo]

Hey,

i tested and it works with single group selection and also with multiple groups which touch each other! 

it works also if the objects are not grouped. all objects within the polyline rotate and the routine makes automatically a group of it, so i don't have to do it before. grand!

gents, my problem is solved! thanks a thousands! 

[hmsilva]

---

@ВeekeeCZ wrote:

---

@hmsilva wrote:

---

@gringooo wrote:

...

one thing:

i take BeekeeCZ's code and Henrique's addition and it works , but only correctly if the groups don`t touch each other.

is it possible the groups can touch each other and the routine works as well?

---

Yes, it should be possible, but with a different approach, not using (ssget "_CP" lst)) and only for groups...

If I have some free time during the weekend, I'll see what I can do.

Henrique

---

Yes, I would replace _CP with _WP... it could make a difference 🙂 ... I know still not perfect.

---

Nicely done! 🙂

Henrique