基于VB&AutoCAD的螺旋面的绘制(原代码)
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 这是什么东东
页:
[1]