TranslateCoordinates 方法 (ActiveX) 
将点从一个坐标系转换为另一个坐标系。 支持的平台:仅限 Windows 签名VBA: RetVal = object.TranslateCoordinates(Point, FromCoordSystem, ToCoordSystem, Displacement, [OCSNormal]) 
 返回值 (RetVal)类型:变体(双打的三元素阵列) 转换后的 3D 坐标。 言论不能直接将坐标从一个 OCS 转换为另一个 OCS。为此,首先将坐标从一个 OCS 转换为中间坐标系,例如 WCS。然后将该坐标转换为第二个 OCS。 要将 or 对象上的点从 OCS 转换为 WCS,请执行以下操作:PolylineLWPolyline 
 例子VBA: Sub 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.
    
    AppActivate ThisDrawing.Application.Caption
    
    ' Create a UCS named "New_UCS" in current drawing
    Dim ucsObj As AcadUCS
    Dim origin(0 To 2) As Double
    Dim xAxisPnt(0 To 2) As Double
    Dim yAxisPnt(0 To 2) As Double
    
    ' Define the UCS
    origin(0) = 2#: origin(1) = 2#: origin(2) = 2#
    xAxisPnt(0) = 5#: xAxisPnt(1) = 2#: xAxisPnt(2) = 2#
    yAxisPnt(0) = 2#: yAxisPnt(1) = 6#: yAxisPnt(2) = 2#
    
    ' Add the UCS to the UserCoordinatesSystems collection
    Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
    ThisDrawing.ActiveUCS = ucsObj
    
    ' Get the active viewport and make sure the UCS icon is on
    Dim viewportObj As AcadViewport
    Set viewportObj = ThisDrawing.ActiveViewport
    viewportObj.UCSIconOn = True
    viewportObj.UCSIconAtOrigin = True
    ThisDrawing.ActiveViewport = viewportObj
   
    ' Have the user enter a point
    Dim pointWCS As Variant
    pointWCS = ThisDrawing.Utility.GetPoint(, "Enter a point to translate:")
    
    ' Translate the point into UCS coordinates
    Dim pointUCS As Variant
    pointUCS = ThisDrawing.Utility.TranslateCoordinates(pointWCS, acWorld, acUCS, False)
    
    ' Display the coordinates of the point
    MsgBox "The point has the following coordinates:" & vbCrLf & _
           "WCS: " & pointWCS(0) & ", " & pointWCS(1) & ", " & pointWCS(2) & vbCrLf & _
           "UCS: " & pointUCS(0) & ", " & pointUCS(1) & ", " & pointUCS(2), , "TranslateCoordinates Example"
End Sub
可视化 LISP: (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)))
)
 | 
|Archiver|CAD开发者社区
( 苏ICP备2022047690号-1   苏公网安备32011402011833)
GMT+8, 2025-11-5 00:06
Powered by Discuz! X3.4
Copyright © 2001-2021, Tencent Cloud.