用戶使用的坐標(biāo)系一般為世界坐標(biāo)系，在某些情況下，自定義一個(gè)用戶坐標(biāo)系，可使繪圖容易，UCS坐標(biāo)系相對(duì)于WCS坐標(biāo)系可以由平移和旋轉(zhuǎn)，創(chuàng)建UCS語(yǔ)法格式如下。

RetVal=AcadApp.ActiveDocument.UserCoordinateSystems.Add(Origin,xAisPoint,yAxisPoint,Name)

下面的代碼在WCS中創(chuàng)建一個(gè)長(zhǎng)、寬均為4，高為1的立方體，然后再轉(zhuǎn)換到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