Transforming Points in mirrored blocks

I've been breaking my head on this today. I've got a request for a routine which should "replace" a wipeout inside a block with 2x 2dSolids. The reason is we're using a door block with a wipeout to "cut" the wall & hatching without actually needing to trim. While this works great for technical drawings, it's when we're doing presentations and need to solid hatch the areas we end up with these white spots under the doors (as if each door has a threshold plank).

So I thought I could simply redefine the block, replacing the wipeout with a SOLID. But no go, since the hatched areas could have any colour and there could be 2 different colours either side of the door. Th us the idea is now to create 2 separate SOLIDS outside of each block reference and send them just underneath the door block. That works fine, for even scaled and/or dynamic blocks - but when they're mirrored I don't seem to get it right with simple coding.

After lots of searching I've come across this thread, but none of these seem to do what I'm after. At the moment I'm using Peter Jamtgaart's code to do the transformation. Just since it works the best with non-uniformly scaled blocks an such with the absolute minimum of coding. The problem is that if I use it on a mirrored block the solids are always off - as if the block was mirrored back either along the X/Y axis about its insertion point.

The work-around I've currently made (to Peter's code) is checking the XEffectiveScaleFactor for a value less than 0.0 (i.e. to see if it's mirrored). If so I create a temporary mirror of this block about the Y axis, generate the point from that and using a transform with a negative Z normal to "un-mirror" the point. Unfortunately this makes for 4 temporary blocks to each blockreference (since I want to get 4 points). I know I can wrap it all inside an undo group, but it just feels messy to me. Anyone know how I can do away with the temporary blocks? Either by transforming the original back-and-forth, or preferably just through calculation and leave the block well alone? See my modified lisp in the cadtips page.

There must be some arb thing which I simply cannot get my head around at the moment. Maybe I'm just growing old and senile? Shame really ... I didn't think I'm that over the hill!

Actually just doing a test now, it seems Peter's code is even worse than just with mirrored blocks. If the block is non-uniformly scaled and rotated other than 0.0 or 180.0 degrees the points are off as well. Here's my test code:

;****************************************************************************************************
; Written By: Peter Jamtgaard copr 2009
; Function for transforming a point from block object coordinate system to a world coordinate system.
; It handles non uniform scaled blocks
; Syntax:  (TranslateWorldToObject <block object> <point in world>)
; Syntax  (TranslateObjectToWorld <block object> <point inside block>)
; Returns point in World
;****************************************************************************************************

(defun TranslateObjectToWorld (objBlock         ; Block object 
                              lstPointInBlock  ; Coordinates of point (RELATIVE TO BASE POINT)
                                               ; inside the block
                              /       
                              lstInsertion     ; Insertion Point of Block
                              lstPoint         ; List Point of return translate coordinates
                              lstPointInWorld  ; Coordinates of point inside the WorldCS
                              sngTheta         ; Rotation angle of Block
                              varReturn        ; Variant return of translate coordinates
                             )
(if (not objDocument)(setq objDocument (vla-get-activedocument 
                                        (vlax-get-acad-object))))
(setq lstInsertion    (vlax-get objBlock "insertionpoint")
      sngTheta        (vla-get-rotation objBlock)
      lstPointInBlock (list (* (vla-get-XEffectiveScaleFactor objBlock)
                                (+ (*    (cos sngTheta) (car  lstPointInBlock))
                                   (* -1 (sin sngTheta) (cadr lstPointInBlock))))
                             (* (vla-get-YEffectiveScaleFactor objBlock)
                                (+ (*    (sin sngTheta) (car  lstPointInBlock))
                                   (*    (cos sngTheta) (cadr lstPointInBlock))))
                             (* (vla-get-ZEffectiveScaleFactor objBlock)
                                (caddr lstPointInBlock)))
      varReturn       (vla-translateCoordinates (vla-get-utility
                                                objDocument)                
                                                (vlax-3d-point lstPointInBlock)
                                                acOCS
                                                acWorld
                                                :vlax-false
                                                (vla-get-normal objBlock))
      lstPointInWorld (mapcar '+ lstInsertion 
                                 (vlax-safearray->list (variant-value varReturn)))
)
)

;****************************************************************************************************
; Written By: Peter Jamtgaard copr 2009
; Function for transforming a point from block object coordinate system to a world coordinate system.
; It handles non uniform scaled blocks
; Syntax:  (TranslateWorldToObject <block object> <point in world>)
; Syntax  (TranslateObjectToWorld <block object> <point inside block>)
; Returns point in World
;****************************************************************************************************

(defun TranslateObjectToWorld1 (objBlock ; Block object 
                              lstPointInBlock ; Coordinates of point (RELATIVE TO BASE POINT)
; inside the block
                              / lstInsertion ; Insertion Point of Block
                              lstPoint ; List Point of return translate coordinates
                              lstPointInWorld ; Coordinates of point inside the WorldCS
                              sngTheta ; Rotation angle of Block
                              varReturn ; Variant return of translate coordinates
                              toMirror ; State of mirrored block (by Irn?)
                              )
 (if (not objDocument)
   (setq objDocument
          (vla-get-activedocument
            (vlax-get-acad-object)
          )
   )
 )
 ;; By Irn?: Check if block's mirrored & create an "unmirrored" block about the Y axis.
 (if (setq toMirror (< (vla-get-XEffectiveScaleFactor objBlock) 0.0))
   (setq objBlock     (vlax-invoke objBlock 'Mirror '(0.0 0.0 0.0) '(0.0 1.0 0.0)))
 )
 
 (setq lstInsertion (vlax-get objBlock "insertionpoint")
       sngTheta     (vla-get-rotation objBlock)
       lstPointInBlock (list (* (vla-get-XEffectiveScaleFactor objBlock)
                                (+ (* (cos sngTheta) (car lstPointInBlock))
                                   (* -1 (sin sngTheta) (cadr lstPointInBlock))
                                )
                             )
                             (* (vla-get-YEffectiveScaleFactor objBlock)
                                (+ (* (sin sngTheta) (car lstPointInBlock))
                                   (* (cos sngTheta) (cadr lstPointInBlock))
                                )
                             )
                             (* (vla-get-ZEffectiveScaleFactor objBlock)
                                (caddr lstPointInBlock)
                             )
                       )
       varReturn       (vla-translateCoordinates
                         (vla-get-utility
                           objDocument
                         )
                         (vlax-3d-point lstPointInBlock)
                         acOCS
                         acWorld
                         :vlax-false
                         (vla-get-normal objBlock)
                       )
       lstPointInWorld (mapcar '+
                               lstInsertion
                               (vlax-safearray->list (variant-value varReturn))
                       )
 )
 ;; By Irn?: Check if block was "unmirrored"
 (if toMirror
   (progn
     (vla-Delete objBlock) ;Erase the temporary "unmirored" block.
     (trans lstPointInWorld '(0.0 0.0 -1.0) 0) ;Translate the "unmirored" point as mirrored about the Y axis
   )
   lstPointInWorld ;If not mirrored, just send calculated point
 )
)


(defun c:Pt2WCS-test (/ ss eo pts pt)
 (setq pts '((500.0 0.0 0.0) (0.0 0.0 0.0) (500.0 200.0 0.0)))
 (if (and (ssget "_:L" '((0 . "INSERT,*POLY*")))
          (setq ss (vla-get-ActiveSelectionset (vla-get-ActiveDocument (vlax-get-acad-object))))
     )
   (progn
     (vlax-for eo ss
       (if (eq (vla-get-ObjectName eo) "AcDbBlockReference")
         (progn
           (setvar "CECOLOR" "1")
           (command "_.PLINE")
           (foreach pt pts
             (command "_None" (TranslateObjectToWorld eo pt))
           )
           (command "")
           (setvar "CECOLOR" "2")
           (command "_.PLINE")
           (foreach pt pts
             (command "_None" (TranslateObjectToWorld1 eo pt))
           )
           (command "")
           (setvar "CECOLOR" "BYLAYER")
         )
         (vla-Delete eo)
       )
     )
     (vla-Delete ss)
   )
 )
 (princ)
)

Command is Pt2WCS-test.

And attached is the resulting DWG. I've made a test block with some text on it to easily see the mirrored / scaled / rotated idea. Then the test code generates 2 polylines. Each should be from the bottom right corner of the block, to the insertion point, to the top right. Peter's code is drawn in red, my modified one in yellow.

Peter's is close to correct on the non-mirrored blocks, except for rotated blocks where the direction and scaling seems off. On the mirrored blocks it's off by "miles". My mod does the same thing on the non-mirrored, but at least on the mirrored it's not worse.

Drawing1.dwg

Try this Irne:

;;---------------------=={ WCS->Geom }==----------------------;;
;;                                                            ;;
;;  Returns the Transformation Matrix and Translation Vector  ;;
;;  for transforming Block Definition Geometry to a Block     ;;
;;  Reference.                                                ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  SourceBlock - VLA Block Reference Object                  ;;
;;------------------------------------------------------------;;
;;  Returns:  List of 3x3 Transformation Matrix, Vector       ;;
;;------------------------------------------------------------;;

(defun LM:WCS->Geom ( SourceBlock / norm ang x y z )
 ;; © Lee Mac 2010
 (vl-load-com)

 (setq norm (vlax-get SourceBlock 'Normal)
        ang (vla-get-rotation SourceBlock))
     
 (mapcar 'set '(x y z)
   (mapcar
     '(lambda ( prop alt )
        (vlax-get-property SourceBlock
          (if (vlax-property-available-p SourceBlock prop) prop alt)
        )
      )
     '(XEffectiveScaleFactor YEffectiveScaleFactor ZEffectiveScaleFactor)
     '(XScaleFactor          YScaleFactor          ZScaleFactor         )
   )
 )
 (
   (lambda ( m )
     (list m
       (mapcar '- (vlax-get SourceBlock 'InsertionPoint)
         (mxv m
           (cdr (assoc 10 (tblsearch "BLOCK" (vla-get-name SourceBlock))))
         )
       )
     )
   )
   (mxm
     (mapcar '(lambda ( e ) (trans e 0 norm t))
       '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
     )
     (mxm
       (list
         (list (cos ang) (sin (- ang)) 0.)
         (list (sin ang) (cos ang)     0.)
         (list     0.        0.        1.)
       )
       (list
         (list x 0. 0.)
         (list 0. y 0.)
         (list 0. 0. z)
       )
     )
   )
 )
)

;;-----------=={ Apply Matrix Transformation }==--------------;;
;;                                                            ;;
;;  Transforms a VLA-Object or Point List using a             ;;
;;  Transformation Matrix                                     ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  target - VLA-Object or Point List to Transform            ;;
;;  matrix - 3x3 Matrix by which to Transform object          ;;
;;  vector - 3D translation vector                            ;;
;;------------------------------------------------------------;;

(defun LM:ApplyMatrixTransformation ( target matrix vector ) (vl-load-com)
 ;; © Lee Mac 2010
 (cond
   ( (eq 'VLA-OBJECT (type target))
    
     (vla-TransformBy target
       (vlax-tMatrix
         (append (mapcar '(lambda ( x v ) (append x (list v))) matrix vector)
          '((0. 0. 0. 1.))
         )
       )
     )
   )
   ( (listp target)

     (mapcar
       (function
         (lambda ( point ) (mapcar '+ (mxv matrix point) vector))
       )
       target
     )
   )        
 )
)

;; Matrix x Vector - Lee Mac 2010
;; Args: m - nxn matrix, v - vector in R^n

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

;; Matrix x Matrix - Lee Mac 2010
;; Args: m,n - nxn matrices

(defun mxm ( m n )
 ( (lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)

;; Matrix Transpose - Lee Mac 2010
;; Args: m - nxn matrix

(defun trp ( m )
 (apply 'mapcar (cons 'list m))
)

With your test function:

(defun c:Pt2WCS-test (/ ss eo pts pt)
 (setq pts '((500.0 0.0 0.0) (0.0 0.0 0.0) (500.0 200.0 0.0)))
 (if (and (ssget "_:L" '((0 . "INSERT,*POLY*")))
          (setq ss (vla-get-ActiveSelectionset (vla-get-ActiveDocument (vlax-get-acad-object))))
     )
   (progn
     (setvar 'PDMODE 34)
     (vlax-for eo ss
       (if (eq (vla-get-ObjectName eo) "AcDbBlockReference")
         (progn
           (setvar "CECOLOR" "1")
           (command "_.PLINE")
           (foreach pt pts
             (command "_None" (TranslateObjectToWorld eo pt))
           )
           (command "")
           (setvar "CECOLOR" "2")
           (command "_.PLINE")
           (foreach pt pts
             (command "_None" (TranslateObjectToWorld1 eo pt))
           )
           (command "")           
           (setvar "CECOLOR" "3")
           (foreach pt (apply 'LM:ApplyMatrixTransformation (cons pts (LM:WCS->Geom eo)))
             (entmakex
               (list
                 (cons 0 "POINT")
                 (cons 10 pt)
                 (cons 210 (vlax-get eo 'normal))
               )
             )
           )            
           (setvar "CECOLOR" "BYLAYER")
         )
         (vla-Delete eo)
       )
     )
     (vla-Delete ss)
   )
 )
 (princ)
)

Mostly developed from my program here, here and here.

Thanks Lee, that seems to work perfectly. Now to figure out what it actually does so I know how to do it instead of simply re-using someone's code!

Thanks Lee, that seems to work perfectly. Now to figure out what it actually does so I know how to do it instead of simply re-using someone's code!

Thanks Irné, good to hear