Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
3 replies to this topic

#1 rungxanhonline

rungxanhonline

    biết zoom

  • Members
  • Pip
  • 15 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 22 October 2010 - 05:22 PM

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!
  • 0

#2 rungxanhonline

rungxanhonline

    biết zoom

  • Members
  • Pip
  • 15 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 23 October 2010 - 11:24 AM

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

#3 phantuhuong

phantuhuong

    biết dimstyle

  • Moderator
  • PipPipPipPipPip
  • 383 Bài viết
Điểm đánh giá: 200 (khá)

Đã gửi 24 October 2010 - 11:39 PM

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

  • 1
Bồi dưỡng Excel & VBA cho các đơn vị ở Hà Nội và khu vực lân cận

Từng bước loại đồ Tàu ra khỏi cuộc sống!


#4 rungxanhonline

rungxanhonline

    biết zoom

  • Members
  • Pip
  • 15 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 25 October 2010 - 11:04 AM

Thank bác nhiều!
  • 0