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