用户使用的坐标系一般为世界坐标系,在某些情况下,自定义一个用户坐标系,可使绘图容易,UCS坐标系相对于WCS坐标系可以由平移和旋转,创建UCS语法格式如下。
RetVal=AcadApp.ActiveDocument.UserCoordinateSystems.Add(Origin,xAisPoint,yAxisPoint,Name)
下面的代码在WCS中创建一个长、宽均为4,高为1的立方体,然后再转换到UCS中。
Private Sub Command1_Click()
Dim boxobj As Acad3DSolid
Dim length As Double, width As Double, height As Double
Dim center(0 To 2) As Double
center(0) = 2#: center(1) = 2#: center(2) = 0
length = 4: width = 4: height = 1
Set boxobj = acadapp.ActiveDocument.ModelSpace.AddBox(center, length, width, height)
ZoomExtents
Dim ucsobj As AcadUCS
Dim origin(0 To 2) As Double
Dim xaxispoint(0 To 2) As Double
Dim yaxispoint(0 To 2) As Double
origin(0) = 2: origin(1) = 2: origin(2) = 0
xaxispoint(0) = 4: xaxispoint(1) = 4: xaxispoint(2) = 0
yaxispoint(0) = 0: yaxispoint(1) = 4: yaxispoint(2) = 0
Set ucsobj = acadapp.ActiveDocument.UserCoordinateSystems.Add(origin, xaxispoint, yaxispoint, "ucs1")
acadapp.ActiveDocument.ActiveUCS = ucsobj
acadapp.ActiveDocument.ActiveViewport.UCSIconOn = True
acadapp.ActiveDocument.ActiveViewport.UCSIconAtOrigin = True
Dim transmatrix As Variant
transmatrix = ucsobj.GetUCSMatrix()
boxobj.TransformBy (transmatrix)
End Sub