声振论坛

 找回密码
 我要加入

QQ登录

只需一步,快速开始

查看: 3036|回复: 2

[AutoCAD] 单叶双曲面(vb&autocad)(源代码公布)

[复制链接]
发表于 2006-5-17 12:25 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?我要加入

x
本人的作业。请鼓励阿

[ 本帖最后由 huright 于 2007-5-24 21:05 编辑 ]
1.JPG

评分

1

查看全部评分

回复
分享到:

使用道具 举报

发表于 2006-5-18 08:20 | 显示全部楼层

回复:(huright)单叶双曲面(vb&autocad)

大家可能更关心怎么做出来的
 楼主| 发表于 2007-5-24 21:02 | 显示全部楼层

源代码公布

Private Sub Command1_Click()
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
Dim pt0(0 To 2) As Double
Dim d1 As Double
Dim d2 As Double
Dim hui As Acad3DSolid
Dim circle1 As AcadCircle
Dim circle2 As AcadCircle
Dim h As Double
Dim d0 As Double
Dim angle As Double
d0 = Me.Text4
h = Me.Text5
d1 = Me.Text1
d2 = Me.Text2
If d0 > d1 Then
MsgBox "输入错误,请重新输入!"
End If
If d0 > d2 Then
MsgBox "输入错误,请重新输入!"
End If
angle = Atn(Sqr(d1 * d1 - d0 * d0) / d0) + Atn(Sqr(d2 * d2 - d0 * d0) / d0)
pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = 0: pt2(1) = 0: pt2(2) = -h
Set circle1 = ActiveDocument.ModelSpace.AddCircle(pt1, d1 / 2)
circle1.Color = acGreen
Set circle2 = ActiveDocument.ModelSpace.AddCircle(pt2, d2 / 2)
circle2.Color = acGreen
Dim i As Integer
Dim x1(0 To 360) As Double
Dim y1(0 To 360) As Double
Dim x2(0 To 360) As Double
Dim y2(0 To 360) As Double
Dim line As AcadLine
Dim stpt(0 To 2) As Double
Dim enpt(0 To 2) As Double
Dim k As Integer
k = Me.Text3
Me.Text6 = angle
For i = 1 To 359 Step 360 / k
x1(i) = (d1 / 2) * Cos(i * 3.1415926 / 180)
y1(i) = (d1 / 2) * Sin(i * 3.1415926 / 180)
x2(i) = (d2 / 2) * Cos(i * 3.1415926 / 180 + angle)
y2(i) = (d2 / 2) * Sin(i * 3.1415926 / 180 + angle)
stpt(0) = x1(i): stpt(1) = y1(i): stpt(2) = 0
enpt(0) = x2(i): enpt(1) = y2(i): enpt(2) = -h
Set line = ActiveDocument.ModelSpace.AddLine(stpt, enpt)
line.Color = acRed
Next i
line.Update
End Sub
您需要登录后才可以回帖 登录 | 我要加入

本版积分规则

QQ|小黑屋|Archiver|手机版|联系我们|声振论坛

GMT+8, 2024-11-29 00:46 , Processed in 0.092511 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表