[编程交流] 镜像中的变换点

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

2