- UID
- 85282
- 积分
- 0
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2003-10-10
- 最后登录
- 1970-1-1
|
楼主 |
发表于 2004-6-11 18:03:36
|
显示全部楼层
谢谢lzh741206 版主,修改后程序如下:
Sub luokong()
Dim pi As Double
pi = Atn(1) * 4
Dim insertPnt As Variant
Dim prompt1 As String
prompt1 = vbCrLf & "输入插入点:"
insertPnt = ThisDrawing.Utility.GetPoint(, prompt1)
Dim rad As Double
prompt1 = vbCrLf & "输入螺纹直径:"
rad = ThisDrawing.Utility.GetReal(prompt1) / 2
Dim objCircle As AcadCircle
Dim objArc As AcadArc
Set objCircle = ThisDrawing.ModelSpace.AddCircle(insertPnt, rad * 0.85)
objCircle.Layer = "粗线"
Set objArc = ThisDrawing.ModelSpace.AddArc _
(insertPnt, rad, 280 * pi / 180, 190 / 180 * pi)
objArc.Layer = "细线"
Dim cntLineStartPnt As Variant
Dim cntLineEndPnt As Variant
Dim objLine As AcadLine
cntLineStartPnt = ThisDrawing.Utility.PolarPoint(insertPnt, 0, rad + 2)
cntLineEndPnt = ThisDrawing.Utility.PolarPoint(insertPnt, 0, 0 - rad - 2)
Set objLine = ThisDrawing.ModelSpace.AddLine(cntLineStartPnt, cntLineEndPnt)
objLine.Layer = "中心线"
cntLineStartPnt = ThisDrawing.Utility.PolarPoint(insertPnt, pi / 2, rad + 2)
cntLineEndPnt = ThisDrawing.Utility.PolarPoint(insertPnt, pi * 3 / 2, rad + 2)
Set objLine = ThisDrawing.ModelSpace.AddLine(cntLineStartPnt, cntLineEndPnt)
objLine.Layer = "中心线"
ThisDrawing.Application.ZoomAll
End Sub |
|