huright 发表于 2006-5-17 12:22

螺旋面(vb&autocad)(源代码公布)

本人的作业。发给初学者。

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

aren207 发表于 2006-5-17 15:12

本帖最后由 wdhd 于 2016-3-30 10:19 编辑

  挺好看的

huright 发表于 2006-5-17 17:21

大家看了,要顶阿

多情清秋 发表于 2006-5-18 08:16

回复:(huright)螺旋面(vb&autocad)

很漂亮,能否将流程贴一下?

huright 发表于 2007-5-24 21:03

源代码公布

Private Sub Command1_Click()
Dim theta, r1, r2, h1, h0, l
l = Val(Me.Text1)
theta = Val(Me.Text2) / 180 * 3.1415
r1 = Val(Me.Text3)
r2 = Val(Me.Text4)
ActiveDocument.SendCommand "_shademode" + vbCr + "_G" + vbCr
Dim center_point(0 To 2) As Double
center_point(0) = 0: center_point(1) = 0: center_point(2) = 0
Dim lines(0 To 0) As AcadCircle
Set lines(0) = ActiveDocument.ModelSpace.AddCircle(center_point, r2)
Dim region As Variant
region = ActiveDocument.ModelSpace.AddRegion(lines)
Dim base As Acad3DSolid
h = 5 * l
Set base = ActiveDocument.ModelSpace.AddExtrudedSolid(region(0), h, 0)
base.Color = acBlue
Dim ptcontrol() As Double
Dim ptcontrol1() As Double
Dim k As Integer
Dim liness(0 To 700) As AcadLine
k = 700
ReDim ptcontrol(3 * k + 2) As Double
ReDim ptcontrol1(3 * k + 2) As Double
Dim stpt(0 To 2) As Double
Dim etpt(0 To 2) As Double
For i = 0 To k Step 1
ptcontrol(3 * i) = r2 * Cos(2 * 3.1415926 * i / 180)
ptcontrol(3 * i + 1) = r2 * Sin(2 * 3.1415926 * i / 180)
ptcontrol(3 * i + 2) = l / (2 * 3.1415) * (2 * 3.1415926 * i / 180) + r2 * Tan(theta) - 5
stpt(0) = ptcontrol(3 * i): stpt(1) = ptcontrol(3 * i + 1): stpt(2) = ptcontrol(3 * i + 2)
ptcontrol1(3 * i) = r1 * Cos(2 * 3.1415926 * i / 180)
ptcontrol1(3 * i + 1) = r1 * Sin(2 * 3.1415926 * i / 180)
ptcontrol1(3 * i + 2) = l / (2 * 3.1415) * (2 * 3.1415926 * i / 180) + r1 * Tan(theta) - 5
etpt(0) = ptcontrol1(3 * i): etpt(1) = ptcontrol1(3 * i + 1): etpt(2) = ptcontrol1(3 * i + 2)
Set liness(i) = ActiveDocument.ModelSpace.AddLine(stpt, etpt)
liness(i).Color = acRed
Next i
Dim luo As Acad3DPolyline
Set luo = ActiveDocument.ModelSpace.Add3DPoly(ptcontrol1)
luo.Color = acGreen
Dim wailuo As Acad3DPolyline
Set wailuo = ActiveDocument.ModelSpace.Add3DPoly(ptcontrol)
wailuo.Color = acYellow
End Sub
Private Sub Command2_Click()
End
End Sub

无水1324 发表于 2007-6-3 11:54

我运行的时候出了问题!
还要输入点

MVH 发表于 2007-6-4 14:13

没装VB,试不了

huright 发表于 2007-6-4 20:53

不应该有问题。
页: [1]
查看完整版本: 螺旋面(vb&autocad)(源代码公布)