VB编程添加AutoCAD用户坐标系

用户使用的坐标系一般为世界坐标系，在某些情况下，自定义一个用户坐标系，可使绘图容易，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