Sub Ch8_NewUCS()
‘ Define the variables we will need
Dim ucsObj As AcadUCS
Dim xAxisPnt(0 To 2) As Double
Dim yAxisPnt(0 To 2) As Double
‘ Define the UCS points
Dim origin As Variant
‘ Return a point using a prompt
origin = ThisDrawing.Utility.GetPoint(, “Enter a point: “)
xAxisPnt(0) = origin(0) + 1: xAxisPnt(1) = origin(1): xAxisPnt(2) = 0
yAxisPnt(0) = origin(0): yAxisPnt(1) = origin(1) + 1: yAxisPnt(2) = 0
Set ucsObj = ThisDrawing.UserCoordinateSystems. _
Add(origin, xAxisPnt, yAxisPnt, “New_UCS”)
ThisDrawing.ActiveViewport.UCSIconAtOrigin = True
ThisDrawing.ActiveViewport.UCSIconOn = True
‘ Make the new UCS the active UCS
ThisDrawing.ActiveUCS = ucsObj
End Sub
위와같이 하여 UCS를 임의로 옮겼습니다
명령창에서는 옮긴 UCS기준점이 0,0,0 으로 작동합니다
그러나 아래 명령을 옮긴 UCS기준으로 할수있는 방법을
어떻게 합니까
고수분 부탁 합니다
Sub poly()
Dim plineObj As AcadPolyline
Dim points(0 To 11) As Double
points(0) = 0: points(1) = 0: points(2) = 0
points(3) = 10: points(4) = 0: points(5) = 0
points(6) = 10: points(7) = 10: points(8) = 0
points(9) = 0: points(10) = 10: points(11) = 0
Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
plineObj.Closed = True
end sub