;;;从AutoCAD 2013 Active Reference帮助中code Examples中提取
;;;本源代码由 xshrimp 2013.2.20 搜集整理,版权归原作者所有!


(vl-load-com)
(defun c:Example_TranslateCoordinates()
    ;; This example creates a UCS with an origin at 2, 2, 2.
    ;; Next, a point is entered by the user. The WCS and UCS
    ;; coordinates of that point are output in a Msgbox.
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))

    ;; Create a UCS named "New_UCS" in current drawing
    ;; Define the UCS
    (setq origin (vlax-3d-point 2 2 2)
          xAxisPnt (vlax-3d-point 5 2 2)
          yAxisPnt (vlax-3d-point 2 6 2))
    
    ;; Add the UCS to the UserCoordinatesSystems collection
    (setq ucsObj (vla-Add (vla-get-UserCoordinateSystems doc) origin xAxisPnt yAxisPnt "New_UCS"))
    (vla-put-ActiveUCS doc ucsObj)
    
    ;; Get the active viewport and make sure the UCS icon is on
    (setq viewportObj (vla-get-ActiveViewport doc))
    (vla-put-UCSIconOn viewportObj :vlax-true)
    (vla-put-UCSIconAtOrigin viewportObj :vlax-true)
    (vla-put-ActiveViewport doc viewportObj)
   
    ;; Have the user enter a point
    (setq pointWCS (vlax-variant-value (vla-GetPoint (vla-get-Utility doc) nil "\nEnter a point to translate:")))
    
    ;; Translate the point into UCS coordinates
    (setq pointUCS (vlax-variant-value (vla-TranslateCoordinates (vla-get-Utility doc) pointWCS acWorld acUCS :vlax-false)))
    
    ;; Display the coordinates of the point
    (alert (strcat "The point has the following coordinates:"
                   "\nWCS: " (rtos (vlax-safearray-get-element pointWCS 0) 2) ", "
                             (rtos (vlax-safearray-get-element pointWCS 1) 2) ", "
                             (rtos (vlax-safearray-get-element pointWCS 2) 2)
                   "\nUCS: " (rtos (vlax-safearray-get-element pointUCS 0) 2) ", "
                             (rtos (vlax-safearray-get-element pointUCS 1) 2) ", "
                             (rtos (vlax-safearray-get-element pointUCS 2) 2)))
)