[例程]使用UCS坐标系

mccad

Public Sub UseUcs()

    Dim ucsObj As AcadUCS             '声明新的UCS对象变量
    Dim orgPnt(0 To 2) As Double      'UCS原点数组变量
    'X轴和Y轴上的定向点变量
    Dim xPnt(0 To 2) As Double, yPnt(0 To 2) As Double
    '保存当前活动视窗的变量
    Dim cueViewport As AcadViewport
   
    '保存当前活动视窗
    Set curViewport = ThisDrawing.ActiveViewport
   
    '创建一个圆，一开始只能在WCS中实现
    Dim cirObj As AcadCircle
    Dim center(0 To 2) As Double, radius As Double
    center(0) = 25: center(1) = 25: center(2) = 0
    radius = 18
    Set cirObj = ThisDrawing.ModelSpace.AddCircle(center, radius)
   
    ZoomAll
   
    '为UCS的原点和X轴、Y轴上的定向点赋值
    orgPnt(0) = 50: orgPnt(1) = 50: orgPnt(2) = 0
    xPnt(0) = 75: xPnt(1) = 50: xPnt(2) = 0
    yPnt(0) = 50: yPnt(1) = 75: yPnt(2) = 0
   
    '创建一个名为UCS1的用户坐标系
    Set ucsObj = ThisDrawing.UserCoordinateSystems.Add _
                 (orgPnt, xPnt, yPnt, "UCS1")
    '使新创建的UCS1成为活动坐标系
    ThisDrawing.ActiveUCS = ucsObj
    '显示UCS1的图标
    ThisDrawing.ActiveViewport.UCSIconOn = True
    '使UCS1的图标定在原点上
    ThisDrawing.ActiveViewport.UCSIconAtOrigin = True
   
    Dim transMatrix As Variant
   
    '获得UCS相对WCS坐标的变换矩阵
    transMatrix = ucsObj.GetUCSMatrix()
   
    '将WCS中的圆变换到UCS中
    cirObj.TransformBy transMatrix
    cirObj.Update
   
    MsgBox "现在圆已被转换到UCS坐标中了！"
   
    '将当前视窗回复到WCS坐标系中
    ThisDrawing.ActiveViewport = curViewport

End Sub

兰州人

上面例子说明如何在ＵＣＳ坐标系中建立圆的方法．

反之在用户坐标系中已经建立了一个实体．如图示所示的圆弧--句柄为A7圆弧实体

如何获得A7实体的ＵＣＳ信息？？

通过获取A7圆弧的属性数据

RetVal = object.AddArc(Center, Radius, StartAngle, EndAngle)

和用户坐标系恢复到图示的句柄　A7实体状态

此主题相关图片如下：

采用list 查询两个圆弧属性如下:

 句柄 = A6
              圆心 点，X=   1.0611  Y=   1.0491  Z=   0.0000
              半径    0.2594              起点 角度   269              端点 角度    91            长度    0.8258

句柄 = A7
              圆心 点，X=   1.0558  Y=   1.0491  Z=   0.0054
              半径    0.2594     

 相对于 UCS 的拉伸方向:                   X=  -1.0000  Y=   0.0000  Z=   0.0000
            长度    0.8258
             累计角度    182

问题如下

Sub ls()
  Dim lsArc As AcadArc
  Dim rr As AcadEntity
  For Each rr In ThisDrawing.ModelSpace
    Set lsArc = rr
    Debug.Print lsArc.StartAngle

  Next rr
End Sub
用传统方法获取Arc的属性只能是WCS坐标系下的Arc SartPoint,EndPoint,CenterPoint等属性数据.

我需要的数据是

相对于 UCS 的拉伸方向:                   X=  -1.0000  Y=   0.0000  Z=   0.0000
            长度    0.8258
             累计角度    182