Làm sao để thay đổi gốc tọa độ

[rungxanhonline 0]

Các bạn cho mình hỏi trong VBA code thế nào để rời gốc tọa độ sang vị trí mới. Ví dụ mình muốn rời trục tọa độ từ 0,0 điểm 1230,234.

Xin cảm ơn!

[rungxanhonline 0]

Có anh em nào rảnh giúp mình cái nhỉ? đang cần gấp. Thank!

[phantuhuong 218]

Có anh em nào rảnh giúp mình cái nhỉ? đang cần gấp. Thank!

 

 

Bạn nghiên cứu thử phương thức TranslateCoordinates xem sao nhé:

 

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.

' 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

[rungxanhonline 0]

Thank bác nhiều!