[例程]使用UCS坐标系
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实体状态
/images/t42dyzobkwf.gif
此主题相关图片如下：
采用list 查询两个圆弧属性如下:
句柄 = A6
圆心 点，X= 1.0611Y= 1.0491Z= 0.0000
半径 0.2594 起点 角度 269 端点 角度 91 长度 0.8258
句柄 = A7
圆心 点，X= 1.0558Y= 1.0491Z= 0.0054
半径 0.2594
相对于 UCS 的拉伸方向: X=-1.0000Y= 0.0000Z= 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.0000Y= 0.0000Z= 0.0000
长度 0.8258
累计角度 182
页:
[1]