Mirroring entire selection set PLUS mirroring blocks again

Anonymous · ‎10-25-2011

Hi-

I am looking for a way where a user is prompted to select a row of blocks and then that row is completely mirrored about the middle of the selection set - such that if the blocks are originally inserted, from left to right "A" "B" C" then after mirroring, we want them t occupy (roughly) the same space in the drawing area as "C" "B" "A".

Then, immediately after mirroring that selection set in place, each individual block that makes up the selection set is mirrored about its insertion point along the x axis..... basically i need to mirror a selection set of a row of blocks so I change their order of occurrence and then mirror each individual block back again to the way it is meant to look.

Is this possible?

Thanks for reading!

scot-65 · ‎10-25-2011

Sounds like a fun program to write.

It would appear you want to reshuffle instead of mirror.

By flipping the sequence A-B-C, you get CFLIP-BFLIP-AFLIP,

then you want to flip back to read C-B-A?

It is possible to write such a program, unfortunately I cannot

envision this in my head when there are an unknown number

of items (blocks) to reshuffle the order. The function that is used

for this instance *might* be MAPCAR, but I have limited knowledge

of this function.

Another thought would be using LIST, then reversing that list.

The list would contain the entity handle where insert points can

be extracted programmatically (as another list).

Maybe Kent can help out?

Scot-65
A gift of extraordinary Common Sense does not require an Acronym Suffix to be added to my given name.

pbejse · ‎10-25-2011

Like the way Mirrtext 0 works for TEXT but this time for Blocks, Guess it can be done 🙂

Kent1Cooper · ‎10-25-2011

@Anonymous wrote:
....
basically i need to mirror a selection set of a row of blocks so I change their order of occurrence and then mirror each individual block back again to the way it is meant to look.
....

On the theory that someone might just as well want to reverse a column of Blocks in similar fashion, I came up with a dual-command routine -- ReverseBlocks.lsp [attached]. Load it up, and type RBLR to Reverse Blocks in the Left-Right direction, or RBUD to Reverse Blocks in the Up-Down direction.

It has to step through the Blocks individually, looking at each one's bounding box, in order to find the middle axis location for Mirroring the whole set. I figured it was easier to Mirror each Block while it's the currently-considered object. So it flips each Block first, then flips the whole set -- the reverse of the OP description, but functionally equivalent.

Minimally tested, and it has none of the usual bells and whistles [error handling, Osnap control, etc.] yet, but it seems to work.

Kent Cooper, AIA

pbejse · ‎10-25-2011

Same but different:

(defun MirB (ang cord / aDoc ss ssM ptLst mn mx blk pt1 p3)
  (defun _sort (lst dir cord_)
    (car (vl-sort lst
		  '(lambda (p1 p2)
		     ((eval dir) (cord_ p1) (cord_ p2))
		   )
	 )
    )
  )
  (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq ssM (ssadd))
  (setq ss (ssget ":L" '((0 . "INSERT"))))
  (repeat (sslength ss)
    (vla-getboundingbox
      (setq blk (vlax-ename->vla-object (ssname ss 0)))
      'mn
      'mx
    )
    (setq ptLst	(append	(list (vlax-safearray->list mn)
			      (vlax-safearray->list mx)
			)
			ptLst
		)
    )
    (setq ssM (ssadd (vlax-vla-object->ename
		       (vla-mirror
			 blk
			 (setq pt1
				(vlax-3d-point
				  (mapcar (function (lambda (a b) (/ (+ a b) 2.)))
					  (vlax-safearray->list mn)
					  (vlax-safearray->list mx)
				  )
				)
			 )
			 (vla-PolarPoint
			   (vla-get-Utility aDoc)
			   pt1
			   ang
			   100.0
			 )
		       )
		     )
		     ssM
	      )
    )
    (vla-delete blk)
    (ssdel (ssname ss 0) ss)
  )
  (command "_mirror"
	   ssM
	   ""
	   "_non"
	   (setq p3 (mapcar
		      (function (lambda (a b) (/ (+ a b) 2.)))
		      (_sort ptlst '< cord)
		      (_sort ptlst '> cord)
		    )
	   )
	   "_non"
	   (polar p3 ang 10.0)
	   "Yes"
  )
  (princ)
)


(defun c:MirBV ()
  	(mirb 1.57079633 car))
(defun c:MirBH ()
  	(mirb 0.00 cadr))

Rigth now its not as versatile as Kents code,

~~Left to Right mode, i~~

~~'ll modify it later if needed.~~

EDIT: not thouroghly tested

HTH

Lee_Mac · ‎10-26-2011

How about:

(defun c:mirrblocks ( / a m p q s v ) (vl-load-com)  ;; Lee Mac 2011
    (if
        (and
            (ssget '((0 . "INSERT")))
            (setq p (getpoint "\nSpecify 1st Point of Mirror Line: "))
            (setq q (getpoint "\nSpecify 2nd Point of Mirror Line: " p))
            (setq p (trans p 1 0)
                  q (trans q 1 0)
            )
        )
        (progn
            (setq a (* 2.0 (angle p q)))
            (setq m
                (list
                    (list (cos a)    (sin a)  0.)
                    (list (sin a) (- (cos a)) 0.)
                    (list    0.         0.    1.)
                )
            )
            (setq v (mapcar '- p (mxv m p)))
            (vlax-for o
                (setq s (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
                (vla-move (vla-copy o) (vla-get-insertionpoint o)
                    (vlax-3D-point (mapcar '+ (mxv m (vlax-get o 'insertionpoint)) v))
                )
            )
            (vla-delete s)
        )
    )
    (princ)
)

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

It should work for any Mirror Axis.

Based on my Matrix Transformation Functions.

Lee Mac Programming • Twitter • Exchange App Store

Kent1Cooper · ‎10-26-2011

Kent1Cooper wrote:
.... it has none of the usual bells and whistles [error handling, Osnap control, etc.] yet, but it seems to work.

A more developed version.

Kent Cooper, AIA

scot-65 · ‎10-26-2011

Allowing this thought to churn in my head overnight, and determining if this can

relate to my work environment, I have come up with a simple routine where

the user selects two blocks and their position is swapped.

Abbreviated pretense:

We have clients that wish to see a "Street View" of our product.

By creating different elevations of the same plan, we can compose for approval.

However, the client may wish to shuffle the elevations for his desired look.

With this thought - Swapping the second elevation (block) from the left with the

third elevation from the right, I knew I could write a routine under 15 minutes that

occupies less than 20 lines of code.

I did just that.

Enjoy the attachment - SWB Swap Block.

Scot-65
A gift of extraordinary Common Sense does not require an Acronym Suffix to be added to my given name.

alanjt_ · ‎10-27-2011

Fantastic idea Lee!

I hope you don't mind, I made a slight tweak to account for the block's insertionpoint not being at the center...unless I missed something.

(defun c:mirrblocks (/ a m p q s v c)
  (vl-load-com)
  ;; Lee Mac 2011
  (if (and (ssget "_:L" '((0 . "INSERT"))) ; alanjt edit
           (setq p (getpoint "\nSpecify 1st Point of Mirror Line: "))
           (setq q (getpoint "\nSpecify 2nd Point of Mirror Line: " p))
           (setq p (trans p 1 0)
                 q (trans q 1 0)
           )
      )
    (progn
      (setq a (* 2.0 (angle p q)))
      (setq m (list
                (list (cos a) (sin a) 0.)
                (list (sin a) (- (cos a)) 0.)
                (list 0. 0. 1.)
              )
      )
      (setq v (mapcar '- p (mxv m p)))
      (vlax-for o (setq s (vla-get-activeselectionset
                            (vla-get-activedocument (vlax-get-acad-object))
                          )
                  )
        (vla-move (vla-copy o)
                  (vlax-3D-point (setq c (AT:BoundingBoxMidPoint o))) ; alanjt edit
                  (vlax-3D-point (mapcar '+ (mxv m c) v)) ; alanjt edit
        )
      )
      (vla-delete s)
    )
  )
  (princ)
)

;; 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 AT:BoundingBoxMidPoint (obj / a b)
  ;; Return midpoint between boundingbox of specified VLA-OBJECT
  ;; Alan J. Thompson, 07.13.10
  (if (eq (type obj) 'VLA-OBJECT)
    (progn
      (vla-getboundingbox obj 'a 'b)
      (apply (function (lambda (p1 p2) (mapcar (function (lambda (a b) (/ (+ a b) 2.))) p1 p2)))
             (mapcar (function vlax-safearray->list) (list a b))
      )
    )
  )
)

Lee_Mac · ‎10-27-2011

Good catch Alan - thanks

Lee Mac Programming • Twitter • Exchange App Store

alanjt_ · ‎10-27-2011

🙂

pbejse · ‎10-28-2011

depending on the needs of the OP you may need to delete the original block

(vla-move (vla-copy o)
                  (vlax-3D-point (setq c (AT:BoundingBoxMidPoint o))) ; alanjt edit
                  (vlax-3D-point (mapcar '+ (mxv m c) v)) ; alanjt edit
        )
(vla-delete o ) <----

)

or maybe not

Kent1Cooper · ‎10-28-2011

@pbejse wrote:
depending on the needs of the OP you may need to delete the original block

(vla-move (vla-copy o)
....
(vla-delete o ) <----
....

Or, instead of copying and deleting it, just move it?

Kent Cooper, AIA

pbejse · ‎10-28-2011

@Kent1Cooper wrote:
@pbejse wrote:
depending on the needs of the OP you may need to delete the original block

(vla-move (vla-copy o)
....
(vla-delete o ) <----
....
Or, instead of copying and deleting it, just move it?

Yes, but with Vlisp

(vla-move (vla-copy o); <------- this mimicking mirror
                  (vlax-3D-point (setq c (AT:BoundingBoxMidPoint o))) ; alanjt edit
                  (vlax-3D-point (mapcar '+ (mxv m c) v)) ; alanjt edit
        )

but then again, you're right

(vla-move o
                  (vlax-3D-point (setq c (AT:BoundingBoxMidPoint o))) ; alanjt edit
                  (vlax-3D-point (mapcar '+ (mxv m c) v)) ; alanjt edit
        )

EDIT: and of course depending on the needs of the OP

Lee_Mac · ‎10-28-2011

The more 'obvious' method:

(defun c:mirrblock ( / a b c p q s v ) (vl-load-com) ;; Lee Mac 2011
    (if
        (and
            (ssget '((0 . "INSERT")))
            (setq p (getpoint "\nSpecify 1st Point of Mirror Line: "))
            (setq q (getpoint "\nSpecify 2nd Point of Mirror Line: " p))
            (setq p (trans p 1 0)
                  q (trans q 1 0)
                  v (mapcar '- p q)
                  p (vlax-3D-point p)
                  q (vlax-3D-point q)
            )
        )
        (progn
            (vlax-for o
                (setq s (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
                (setq o (vla-mirror o p q))
                (vla-getboundingbox o 'a 'b)
                (setq c (mapcar '(lambda ( a b ) (/ (+ a b) 2.))
                            (vlax-safearray->list a)
                            (vlax-safearray->list b)
                        )
                )
                (vla-mirror o (vlax-3D-point c) (vlax-3D-point (mapcar '+ c v)))
                (vla-delete o)
            )
            (vla-delete s)
        )
    )
    (princ)
)

Lee Mac Programming • Twitter • Exchange App Store