论坛 › AUTOCAD › 用CAD怎么精确画抛物线

手拉手 发表于 2009-3-29 19:47:49

1# hyj_9766
哎哟，还真没画过。待我回去试试看……

手拉手 发表于 2009-3-30 00:03:45

惭愧，一时间还真没画出来……:time:

arminyang126 发表于 2009-3-30 10:00:29

:lol要活到老学到老,所以我们年轻人更应该抓紧学习了，

李建民 发表于 2009-3-30 10:25:29

样条曲线应该是最好用的，但是一般 画的都是大致的 因为我们机器不认识样条曲线

kaiyuan_abin 发表于 2009-4-21 13:35:13

样条曲线，三点就可以画出抛物线了！

小陶子 发表于 2009-4-21 13:51:29

呵呵，还真的没在CAD里面画真实的曲线，一般都是用样条曲线描的

听涛 发表于 2011-8-29 15:00:50

这个真是个难题，现在我把下载的一个做法提供给大家，供参考
1.先用直线命令画一直线（图1）。过程如下：

　　命令: LINE
　　指定第一点: 0,0
　　指定下一点或 [放弃(U)]: 'cal
　　>> 表达式: +
　　(43.3013 -25.0 0.0)
　　指定下一点或 [放弃(U)]: ↙



　　2.移动该直线，如图2。

　　3.用多段线命令画多段线，先向-60度方向拉出适当长度，如图3。


　　4.继续画多段线，完成一个直角三角形，如图4。


　　5.用REVOLVE命令旋转直角三角形，生成一个三维实体，如图5。过程如下：

　　命令: REVOLVE
　　当前线框密度:ISOLINES=4
　　选择对象:（选择直角三角形）
　　选择对象: ↙
　　指定旋转轴的起点或
　　定义轴依照 [对象(O)/X 轴(X)/Y 轴(Y)]:（捕捉A点）
　　指定轴端点: （捕捉B点）
　　指定旋转角度 <360>:↙

　　6.用SECTION命令切割三维实体，生成一个面域，如图6。过程如下：

　　命令: SECTION
　　选择对象: (选择上一步生成的旋转实体)
　　选择对象: ↙
　　指定截面上的第一个点，依照 [对象(O)/Z 轴(Z)/视图(V)/XY 平面(XY)/YZ 平面(YZ)/ZX 平面(ZX)/三点(3)] <三点>: yz
　　指定 YZ 平面上的点 <0,0,0>:（捕捉C点）


　　7.用rotate3d命令对上一步生成的面域进行三维旋转，如图7。过程如下：

　　命令: rotate3d
　　当前正向角度:ANGDIR=逆时针 ANGBASE=0
　　选择对象: （选择上一步生成的面域）
　　选择对象: ↙
　　指定轴上的第一个点或定义轴依据[对象(O)/最近的(L)/视图(V)/X 轴(X)/Y 轴(Y)/Z 轴(Z)/两点(2)]: (捕捉C点) 指定轴上的第二点:（捕捉D点）
　　指定旋转角度或 [参照(R)]: 90



　　8.先用EXPLODE命令分解旋转后的面域，再清理图面，删除不需要的图元，如图8。



　　9.移动抛物线，如图9。完毕！


http://bbs.icax.cn/register.php










Sub trparabola()
Dim bq1, bq2, pt1, pt2 As Variant
Dim aa, ll, yy, a1, a2, a3, a4, aa1, pt3(0 To 2), bq4(0 To 2) As Double
Dim bq3(0 To 2) As Double
Dim ae As Double
Dim pt33(0 To 2) As Double
Dim ptarr(0 To 7) As Double
Dim alt As Variant
Dim objboltb As Acad3DSolid
Dim al As Variant
Dim lens As AcadLWPolyline

'求个控制点
bq1 = ThisDrawing.Utility.GetPoint(, "抛物线顶点: ")
aa = ThisDrawing.Utility.GetReal("输入二次项系数： ")
ll = ThisDrawing.Utility.GetDistance(, "输入开口弦长： ")
aa1 = 1 / aa
yy = aa * (ll / 2) ^ 2
a1 = ThisDrawing.Utility.AngleToReal(-30, acDegrees)
a2 = ThisDrawing.Utility.AngleToReal(30, acDegrees)
a3 = ThisDrawing.Utility.AngleToReal(90, acDegrees)
a4 = ThisDrawing.Utility.AngleToReal(150, acDegrees)
bq2 = ThisDrawing.Utility.PolarPoint(bq1, a2, yy)
pt1 = ThisDrawing.Utility.PolarPoint(bq1, a4, aa1)
pt2 = ThisDrawing.Utility.PolarPoint(bq2, a3, aa1)
pt3(0) = pt2(0): pt3(1) = pt1(1): pt3(2) = pt1(2)
bq3(0) = bq2(0): bq3(1) = bq2(1): bq3(2) = bq2(2) + 10
bq4(0) = bq2(0): bq4(1) = bq1(1): bq4(2) = bq1(2)
pt33(0) = 10: pt33(1) = 0: pt33(2) = 0



ptarr(0) = pt1(0)
ptarr(1) = pt1(1)
ptarr(2) = pt2(0)
ptarr(3) = pt2(1)
ptarr(4) = pt3(0)
ptarr(5) = pt3(1)
ptarr(6) = pt1(0)
ptarr(7) = pt1(1)

'画多段线
Set lens = ThisDrawing.ModelSpace.AddLightWeightPolyline(ptarr)
Dim objlist(0) As AcadEntity
Set objlist(0) = lens

'将多段线变为面域
Dim altregion As AcadRegion
alt = ThisDrawing.ModelSpace.AddRegion(objlist)
objlist(0).Delete
Set altregion = alt(0)

'旋转面域得到圆锥
ae = 2 * Atn(1) * 4
Set objboltb = ThisDrawing.ModelSpace.AddRevolvedSolid(altregion, pt1, pt33, ae)
altregion.Delete

'切圆锥得到抛物线
Set al = objboltb.SectionSolid(bq1, bq2, bq3)
objboltb.Delete
al.Rotate bq1, a1
al.Rotate3D bq1, bq4, a3
Dim explodedobjects As Variant
explodedobjects = al.Explode
al.Delete
Dim i As Integer
Dim kind As String
Dim parabolaobject As AcadSpline
For i = 0 To UBound(explodedobjects)
kind = explodedobjects(i).ObjectName
If kind = "AcDbLine" Then
   explodedobjects(i).Delete
   Else
   Set parabolaobject = explodedobjects(i)
   End If
Next

'旋转抛物线
ThisDrawing.SendCommand "rotate" & vbCr & "(Handent """ & parabolaobject.Handle & """)" & vbCr & "" & vbCr & bq1(0) & "," & bq1(1) & vbCr

End Sub

lovemy006 发表于 2011-8-29 15:10:53

哈哈一直学下去

風雲再起 发表于 2012-9-28 09:56:52

kaiyuan_abin 发表于 2009-4-21 13:35 static/image/common/back.gif
样条曲线，三点就可以画出抛物线了！

用样条曲线怎么画抛物线呢？描点点是哪里求出的呢？

查看完整版本: 用CAD怎么精确画抛物线