[原创]：三维螺旋线

herohao

切换到正视图,画出弹簧的截面圆,进行2维面拉伸(用路径),再用3维面拉伸

herohao

再用阵列
完

ahlzl

最初由 herohao 发布
[B]再用阵列
完 [/B]

我还没细看过程，正在写VBA程序。可你这弹簧太……

Laoyao

33楼主，可以把程序帖上来吗，谢谢。

ahlzl

我写了几行代码，还有点问题，指efan2000斑竹PP。
一、这段代码能画出一“整体”的三维螺旋线，但匝数无法输入，只能在代码中改。

Sub Example_Add3DPoly()
    '画一五匝三维螺旋线
    pi = 3.1415926535
    Dim polyObj As Acad3DPolyline
    Dim points(0 To 3 * 360 * 5 + 2) As Double
    Dim a, b, c, n As Integer
    Dim R, h As Double
    Dim pa As Variant
   
    pa = ThisDrawing.Utility.GetPoint(, "请输入基点：")
    R = ThisDrawing.Utility.GetDistance(pa, "请输入半径：")
    h = ThisDrawing.Utility.GetDistance(pa, "请单匝高度：")
    'n是匝数
    n = 5
   
    For a = 0 To 3 * 360 * n Step 3
    points(a) = pa(0) + R * Cos(2 * pi * (a / 3) / 360)
    Next
    For b = 1 To 3 * 360 * n + 1 Step 3
    points(b) = pa(1) + R * Sin(2 * pi * ((b - 1) / 3) / 360)
    Next
    For c = 2 To 3 * 360 * n + 2 Step 3
    points(c) = pa(2) + h * ((c - 2) / 3) / 360
    Next
    Set polyObj = ThisDrawing.ModelSpace.Add3DPoly(points)
    ZoomAll
End Sub

二、这段代码能输入匝数，但画的不是一“整体”三维螺旋线。

Sub Example_Add3DPoly()
    pi = 3.1415926535
    Dim polyObj As Acad3DPolyline
    Dim points(0 To 3 * 360 + 2) As Double
    Dim a, b, c, n, m As Integer
    Dim R, h As Double
    Dim pa As Variant
   
    pa = ThisDrawing.Utility.GetPoint(, "请输入基点：")
    R = ThisDrawing.Utility.GetDistance(pa, "请输入半径：")
    h = ThisDrawing.Utility.GetDistance(pa, "请单匝高度：")
    n = ThisDrawing.Utility.GetReal("请输入匝数:")
   
    For m = 1 To n Step 1
    For a = 0 To 3 * 360 Step 3
    points(a) = pa(0) + R * Cos(2 * pi * (a / 3) / 360)
    Next
    For b = 1 To 3 * 360 + 1 Step 3
    points(b) = pa(1) + R * Sin(2 * pi * ((b - 1) / 3) / 360)
    Next
    For c = 2 To 3 * 360 + 2 Step 3
    points(c) = pa(2) + h * ((c - 2) / 3) / 360
    Next
    Set polyObj = ThisDrawing.ModelSpace.Add3DPoly(points)
    pa(2) = pa(2) + h
    Next
    ZoomAll
End Sub

to Laoyao：你的程序只能打开EXCEL，却没一条“画”的命令。不行！我又写了一段：
三、将附件解压在C盘根目录，运行下面代码，（速度很慢，也不方便，远不如上两段代码！）
Sub getEXCEL()
Dim excel As Object
Set excelworkbook = Workbooks.Open("c:\3.xls")
Set excel = excelworkbook.Application
excel.Visible = True

Dim xlSheet As Worksheet
Dim a, b, c As Double

Set xlSheet = excelworkbook.Sheets(1)

Dim Points(0 To 1800 * 3 + 2) As Double
Dim polyObj As Acad3DPolyline

For a = 0 To 1800 * 3 + 2 Step 3
Points(a) = xlSheet.Cells((a + 3) / 3, 2).Value
Next
For b = 1 To 1800 * 3 + 2 Step 3
Points(b) = xlSheet.Cells((b + 2) / 3, 3).Value
Next
For c = 2 To 1800 * 3 + 2 Step 3
Points(c) = xlSheet.Cells((c + 1) / 3, 4).Value
Next

Set polyObj = ThisDrawing.ModelSpace.Add3DPoly(Points)
excel.Quit
End Sub

efan2000

For a = 0 To 3 * 360 * n Step 3
points(a) = pa(0) + R * Cos(2 * pi * (a / 3) / 360)
Next
For b = 1 To 3 * 360 * n + 1 Step 3
points(b) = pa(1) + R * Sin(2 * pi * ((b - 1) / 3) / 360)
Next
For c = 2 To 3 * 360 * n + 2 Step 3
points(c) = pa(2) + h * ((c - 2) / 3) / 360
Next
这一部分可在合并在一个循环过程中。如：
For a = 0 To 3 * 360 * n Step 3
points(a) = pa(0) + R * Cos(2 * pi * (a / 3) / 360)
points(a+1) = pa(1) + R * Sin(2 * pi * (a / 3) / 360)
points(a+2) = pa(2) + h * (a / 3) / 360
Next
程序运行一个循环所花费的时间比三个循环的几乎节省了三分之二的时间。类似的，在EXCEL中的操作也可以这样修改：
Dim n As Integer
For a = 0 To 1800 * 3 + 2 Step 3
n=(a + 3) / 3
Points(a) = xlSheet.Cells(n, 2).Value
Points(a+1) = xlSheet.Cells(n, 3).Value
Points(a+2) = xlSheet.Cells(n, 4).Value
Next

Laoyao

Sub Example_Add3DPoly()

    Dim polyObj As Acad3DPolyline
    Dim points() As Double 'change
    Dim a, b, c, n As Integer
    Dim R, h As Double
    Dim pa As Variant
    Const PI = 3.1415926535

    pa = ThisDrawing.Utility.GetPoint(, "Input base point：")
    R = ThisDrawing.Utility.GetDistance(pa, "Input Radius：")
    h = ThisDrawing.Utility.GetDistance(pa, "Input height：")
    n = ThisDrawing.Utility.GetDistance(pa, "Input circles:") 'change

    ReDim points(0 To 3 * 360 * n + 2) As Double 'add

    For a = 0 To 3 * 360 * n Step 3
        points(a) = pa(0) + R * Cos(2 * PI * (a / 3) / 360)
        points(a + 1) = pa(1) + R * Sin(2 * PI * (a / 3) / 360)
        points(a + 2) = pa(2) + h * (a / 3) / 360
    Next

    Set polyObj = ThisDrawing.ModelSpace.Add3DPoly(points)
    ZoomAll
End Sub

如上修改后,可以输出任意匝.

ahlzl

谢谢efan200和laoyao！虽然已是长老了，可VBA方面还是新手……

ssmm5460

能不能详细介绍一下做这些图片是步骤！请指教！
现在对这样一种曲线图，甚至螺旋形的图片是我的薄弱点！
看了后还真有点找到了师傅的感觉！

kailler

最初由 ahlzl 发布
[B][QUOTE]最初由 Laoyao 发布
[B]Sub getDataFromEXCEL()
    Dim xlApp As Excel.Application
    Dim xlWorkBook As Workbook
    Dim xlSheet As Worksheet
    Dim a As Double
    'Open EXCEL
   ... [/B]

'open execel
if declare as not object,u sure include excel.tlb at vb
then
set xlapp=createobject("excel.application")
then ....

ahlzl

我在这儿又贴了个改进的VBA程序和使用方法：http://www.xdcad.net/forum/showt ... d=317570#post317570

qh_1017

你可以将这个文件：3dspiral.zip文件解压后复制到你的硬功夫盘下，然后工具————Autolisp(s)————加载（l），就可以画出任意类形的弹黄类形了。然后在CAD中直接输入3dspiral（二维的用spiral）就可以了，紧接着是六个参数：
1。螺旋线的起点坐标；
2。起始半径；
3。你要的螺旋线的圈数；
4。螺旋线水平方向的间距（0就是等距离的。）；
5。螺旋线竖直方向的间距；
6。最后是螺旋线的近似线数（默认是30，越大越精确。）。
注：这只是一种近似的画法，特别是非圆截面（矩形、棱形、梯形）的弹簧用此方法绘制是不可行的。

luospe

请问哪里有画3D弹簧的程序　下载

qh_1017

先看看这个。

qh_1017

我想应该能够满足大家的要求了吧！