[求助]：怎样用vba获得一条polyline坐标?

frank

绿线是一条polyline，怎样能获得A、B、C、D四点的坐标和
B、C点所对应圆弧的半径？（虚线是没有的线，是为示意C、D
两点是交点才画的）最好能用vba。
我知道polyline有一个属性Coordinate可以获得坐标，那怎么获得交点的坐标和圆弧的半径？
望各位高手能告知，本人急用，谢谢！
图在附见。

CamPtt

2. 
   
3. 
   
4. '因其中有自编函数，无法直接运行，不知能否参考
   
5. 
   
6.     Do While i < numberDd
   
7. 
   
8.         If i = numberDd - 1 And objPline.GetBulge(numberDd - 2) <> 0 Then
   
9.             Exit Do '如果多义线最后一段为圆弧,退出
   
10.         End If
    
11.         
    
12.         pubNumberJd = pubNumberJd + 1
    
13.         ReDim Preserve pubJd(0 To pubNumberJd - 1) '动态数组
    
14.         td = objPline.GetBulge(i) '顶点凸度
    
15.         
    
16.         With pubJd(pubNumberJd - 1)
    
17.          .bh = pubNumberJd
    
18.         If td = 0 Then '下一段不是圆弧
    
19.             .r = 0 '作为不设平曲线的转点
    
20.             
    
21.             '顶点坐标转换到UCS
    
22.             ptv = objPline.Coordinate(i)
    
23.             Mycad3DPointSet pt, ptv(0), ptv(1), objPline.Elevation
    
24.             ptv1 = objUtil.TranslateCoordinates(pt, acOCS, acWorld, False, objPline.Normal)
    
25.             ptv2 = objUtil.TranslateCoordinates(ptv1, acWorld, acUCS, False)
    
26.             MycadPointCopy .ptjd, ptv2
    
27.             i = i + 1
    
28.         
    
29.         Else '下一段是圆弧,该顶点为ZY点
    
30.             
    
31.             '计算ZY坐标
    
32.             ptv = objPline.Coordinate(i)
    
33.             Mycad3DPointSet pt, ptv(0), ptv(1), objPline.Elevation
    
34.             ptvzy = objUtil.TranslateCoordinates(pt, acOCS, acWorld, False, objPline.Normal) 'ZY点WCS坐标
    
35.             ptv = objUtil.TranslateCoordinates(ptvzy, acWorld, acUCS, False)
    
36.             MycadPointCopy .ptzy, ptv 'ZY点UCS坐标
    
37.             
    
38.             '计算YZ坐标
    
39.             ptv = objPline.Coordinate(i + 1)
    
40.             Mycad3DPointSet pt, ptv(0), ptv(1), objPline.Elevation
    
41.             ptvyz = objUtil.TranslateCoordinates(pt, acOCS, acWorld, False, objPline.Normal) 'YZ点WCS坐标
    
42.             ptv = objUtil.TranslateCoordinates(ptvyz, acWorld, acUCS, False)
    
43.             MycadPointCopy .ptyz, ptv 'YZ点UCS坐标
    
44. 
    
45.             '计算圆心坐标
    
46.             ptvo = Plavb_2PtdPto(ptvzy, ptvyz, td) '圆心WCS坐标
    
47.             ptv = objUtil.TranslateCoordinates(ptvo, acWorld, acUCS, False)
    
48.             MycadPointCopy .pto, ptv '圆心UCS坐标
    
49. 
    
50.             '计算曲线元素
    
51.             .r = MycadDistance(.pto, .ptzy)
    
52.             .l = Abs(4 * .r * Atn(td))
    
53.             .zj = .l / .r
    
54.             .t = .r * Tan(.zj / 2)
    
55.             .e = .r * (1 / Cos(.zj / 2) - 1)
    
56.             .j = 2 * .t - .l
    
57.             
    
58.             '计算交点坐标
    
59.             ang1 = objUtil.AngleFromXAxis(ptvo, ptvzy) + PI / 2
    
60.             ang2 = objUtil.AngleFromXAxis(ptvo, ptvyz) + PI / 2
    
61.             ptv1 = objUtil.PolarPoint(ptvzy, ang1, .r)
    
62.             ptv2 = objUtil.PolarPoint(ptvyz, ang2, .r)
    
63.             Set objLine1 = moSpace.AddLine(ptvzy, ptv1)
    
64.             Set objLine2 = moSpace.AddLine(ptvyz, ptv2)
    
65.             ptvjd = objLine1.IntersectWith(objLine2, acExtendBoth) '交点WCS坐标
    
66.             objLine1.Delete
    
67.             objLine2.Delete
    
68.             ptv3 = objUtil.TranslateCoordinates(ptvjd, acWorld, acUCS, False)
    
69.             MycadPointCopy .ptjd, ptv3 '交点UCS坐标
    
70. 
    
71.             '计算QZ坐标
    
72.             ang1 = objUtil.AngleFromXAxis(ptvo, ptvjd)
    
73.             ptvqz = objUtil.PolarPoint(ptvo, ang1, .r) 'QZ点WCS坐标
    
74.             ptv = objUtil.TranslateCoordinates(ptvqz, acWorld, acUCS, False)
    
75.             MycadPointCopy .ptqz, ptv 'QZ点UCS坐标
    
76. 
    
77.             If objPline.GetBulge(i + 1) <> 0 Then '下一段还是圆弧
    
78.                i = i + 1
    
79.             Else
    
80.                i = i + 2
    
81.             End If
    
82.         End If
    
83.         End With
    
84.     Loop
    

<br /> <br /> '因其中有自编函数，无法直接运行，不知能否参考<br /> <br />     Do While i < numberDd<br /> <br />         If i = numberDd - 1 And objPline.GetBulge(numberDd - 2) <> 0 Then<br />             Exit Do '如果多义线最后一段为圆弧,退出<br />         End If<br />         <br />         pubNumberJd = pubNumberJd + 1<br />         ReDim Preserve pubJd(0 To pubNumberJd - 1) '动态数组<br />         td = objPline.GetBulge(i) '顶点凸度<br />         <br />         With pubJd(pubNumberJd - 1)<br />          .bh = pubNumberJd<br />         If td = 0 Then '下一段不是圆弧<br />             .r = 0 '作为不设平曲线的转点<br />             <br />             '顶点坐标转换到UCS<br />             ptv = objPline.Coordinate(i)<br />             Mycad3DPointSet pt, ptv(0), ptv(1), objPline.Elevation<br />             ptv1 = objUtil.TranslateCoordinates(pt, acOCS, acWorld, False, objPline.Normal)<br />             ptv2 = objUtil.TranslateCoordinates(ptv1, acWorld, acUCS, False)<br />             MycadPointCopy .ptjd, ptv2<br />             i = i + 1<br />         <br />         Else '下一段是圆弧,该顶点为ZY点<br />             <br />             '计算ZY坐标<br />             ptv = objPline.Coordinate(i)<br />             Mycad3DPointSet pt, ptv(0), ptv(1), objPline.Elevation<br />             ptvzy = objUtil.TranslateCoordinates(pt, acOCS, acWorld, False, objPline.Normal) 'ZY点WCS坐标<br />             ptv = objUtil.TranslateCoordinates(ptvzy, acWorld, acUCS, False)<br />             MycadPointCopy .ptzy, ptv 'ZY点UCS坐标<br />             <br />             '计算YZ坐标<br />             ptv = objPline.Coordinate(i + 1)<br />             Mycad3DPointSet pt, ptv(0), ptv(1), objPline.Elevation<br />             ptvyz = objUtil.TranslateCoordinates(pt, acOCS, acWorld, False, objPline.Normal) 'YZ点WCS坐标<br />             ptv = objUtil.TranslateCoordinates(ptvyz, acWorld, acUCS, False)<br />             MycadPointCopy .ptyz, ptv 'YZ点UCS坐标<br /> <br />             '计算圆心坐标<br />             ptvo = Plavb_2PtdPto(ptvzy, ptvyz, td) '圆心WCS坐标<br />             ptv = objUtil.TranslateCoordinates(ptvo, acWorld, acUCS, False)<br />             MycadPointCopy .pto, ptv '圆心UCS坐标<br /> <br />             '计算曲线元素<br />             .r = MycadDistance(.pto, .ptzy)<br />             .l = Abs(4 * .r * Atn(td))<br />             .zj = .l / .r<br />             .t = .r * Tan(.zj / 2)<br />             .e = .r * (1 / Cos(.zj / 2) - 1)<br />             .j = 2 * .t - .l<br />             <br />             '计算交点坐标<br />             ang1 = objUtil.AngleFromXAxis(ptvo, ptvzy) + PI / 2<br />             ang2 = objUtil.AngleFromXAxis(ptvo, ptvyz) + PI / 2<br />             ptv1 = objUtil.PolarPoint(ptvzy, ang1, .r)<br />             ptv2 = objUtil.PolarPoint(ptvyz, ang2, .r)<br />             Set objLine1 = moSpace.AddLine(ptvzy, ptv1)<br />             Set objLine2 = moSpace.AddLine(ptvyz, ptv2)<br />             ptvjd = objLine1.IntersectWith(objLine2, acExtendBoth) '交点WCS坐标<br />             objLine1.Delete<br />             objLine2.Delete<br />             ptv3 = objUtil.TranslateCoordinates(ptvjd, acWorld, acUCS, False)<br />             MycadPointCopy .ptjd, ptv3 '交点UCS坐标<br /> <br />             '计算QZ坐标<br />             ang1 = objUtil.AngleFromXAxis(ptvo, ptvjd)<br />             ptvqz = objUtil.PolarPoint(ptvo, ang1, .r) 'QZ点WCS坐标<br />             ptv = objUtil.TranslateCoordinates(ptvqz, acWorld, acUCS, False)<br />             MycadPointCopy .ptqz, ptv 'QZ点UCS坐标<br /> <br />             If objPline.GetBulge(i + 1) <> 0 Then '下一段还是圆弧<br />                i = i + 1<br />             Else<br />                i = i + 2<br />             End If<br />         End If<br />         End With<br />     Loop<br />

frank

多谢CamPtt兄,程序我大致已看懂,但还有一些问题不太明白,请CamPtt  兄指教:
1   Mycad3DPointSet,MycadPointCopy是什么意思?
2  为什么不从ocs直接转换到ucs，而是先转换到wcs，再转换到ucs？