请大家帮我修改一下绘制长圆的VBA程序

白埠农夫

下面是我写的一个绘制长圆（两端是半圆、中间是矩形）的VBA程序，可根据用户提供的中心坐标、长轴长度和短轴长度、长轴与X轴正方向的夹角绘制方向任意的长圆。

1. 
   
2. Public Sub CreateLongCircle()
   
3.   
   
4.   '获取长圆中心坐标
   
5.   Dim center As Variant
   
6.   center = ThisDrawing.Utility.GetPoint(, "请在屏幕上拾取一点作为长圆的中心或输入中心坐标：")
   
7.   
   
8.   '获取长轴与X轴正方向夹角
   
9.   Dim angle As Double
   
10.   angle = pi / 180 * ThisDrawing.Utility.GetReal("请输入长轴与X轴正方向的夹角：")
    
11.   
    
12.   '获取长轴长度
    
13.   Dim longAxis As Double
    
14.   longAxis = ThisDrawing.Utility.GetReal("请输入长轴长度：")
    
15.   
    
16.   '获取短轴长度
    
17.   Dim shortAxis As Double
    
18.   shortAxis = ThisDrawing.Utility.GetReal("请输入短轴长度：")
    
19.   
    
20.   Dim halfL As Double
    
21.   halfL = (longAxis - shortAxis) / 2
    
22.   Dim halfS As Double
    
23.   halfS = shortAxis / 2
    
24.   
    
25.   '计算各顶点坐标
    
26.   Dim vertices(1 To 8) As Double
    
27.   vertices(1) = center(0) + halfL: vertices(2) = center(1) - halfS
    
28.   vertices(3) = center(0) + halfL: vertices(4) = center(1) + halfS
    
29.   vertices(5) = center(0) - halfL: vertices(6) = center(1) + halfS
    
30.   vertices(7) = center(0) - halfL: vertices(8) = center(1) - halfS
    
31.   
    
32.   Dim plineObj As AcadLWPolyline
    
33.   Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(vertices)
    
34.   
    
35.   plineObj.Closed = True
    
36.   plineObj.SetBulge 0, 1
    
37.   plineObj.SetBulge 2, 1
    
38.   
    
39.   '旋转长圆
    
40.   plineObj.Rotate center, angle
    
41.   plineObj.Update
    
42.   
    
43. End Sub
    

<br /> Public Sub CreateLongCircle()<br />   <br />   '获取长圆中心坐标<br />   Dim center As Variant<br />   center = ThisDrawing.Utility.GetPoint(, "请在屏幕上拾取一点作为长圆的中心或输入中心坐标：")<br />   <br />   '获取长轴与X轴正方向夹角<br />   Dim angle As Double<br />   angle = pi / 180 * ThisDrawing.Utility.GetReal("请输入长轴与X轴正方向的夹角：")<br />   <br />   '获取长轴长度<br />   Dim longAxis As Double<br />   longAxis = ThisDrawing.Utility.GetReal("请输入长轴长度：")<br />   <br />   '获取短轴长度<br />   Dim shortAxis As Double<br />   shortAxis = ThisDrawing.Utility.GetReal("请输入短轴长度：")<br />   <br />   Dim halfL As Double<br />   halfL = (longAxis - shortAxis) / 2<br />   Dim halfS As Double<br />   halfS = shortAxis / 2<br />   <br />   '计算各顶点坐标<br />   Dim vertices(1 To 8) As Double<br />   vertices(1) = center(0) + halfL: vertices(2) = center(1) - halfS<br />   vertices(3) = center(0) + halfL: vertices(4) = center(1) + halfS<br />   vertices(5) = center(0) - halfL: vertices(6) = center(1) + halfS<br />   vertices(7) = center(0) - halfL: vertices(8) = center(1) - halfS<br />   <br />   Dim plineObj As AcadLWPolyline<br />   Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(vertices)<br />   <br />   plineObj.Closed = True<br />   plineObj.SetBulge 0, 1<br />   plineObj.SetBulge 2, 1<br />   <br />   '旋转长圆<br />   plineObj.Rotate center, angle<br />   plineObj.Update<br />   <br /> End Sub<br />

但是我运行后发现每次绘制出来的长圆都是长轴平行于X轴，Rotate函数好像没起作用，请问问题出在哪里？非常感谢！

VBALISPER

没有给PI赋值.pi=0 !!!!!

白埠农夫

VBALISPER 发表于 2012-7-6 10:03
没有给PI赋值.pi=0 !!!!!

非常感谢！问题已解决，确实是您所说的问题。和AutoLISP搞混了，原来VB没有PI这个常数，已经用4*Atn(1)替代了。

crazylsp

可以先定义个常数pi，好像是const pi=3.1415

njyulei

正在找这方面的学习呢，谢谢了，