cad精准抛物线画法

11.先用直线命令画一直线（图1）。过程如下： 　　命令: LINE 　　指定第一点: 0,0 　　指定下一点或 [放弃(U)]: 'cal 　　>> 表达式: +[100*100/200<-30] 　　(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 我一直用作图法画抛线,还有双曲线,,我都是用样作图法的。 　　方法如下: 　　一,确定顶点,焦点,准线; 　　二,根据抛线定义:抛物是一个到定点(F)和定直线L距离相等的动点(P)的轨迹;那么,先从顶点开始,画很多平等的直线,,如果抛线开口向上,,,就从顶点上向等距画直线;建议,以准线为偏移线,输入整数据的偏移量,比如100,101,102,以1MM为增量,因为下一步是画圆,整数就减少输入数字的麻烦。你想画得精细,就取多一些。 　　三，以焦点为圆心画圆，第一个圆的半径是焦点到顶点的距离，，比如，是100，以后，按你设定的增量，101，102，103，，，，，， 　四，这些圆与那个直线有一个交点，，这些交点，就是动点（Ｐ），用样条曲线联起来，就成了抛线。 稍后再写双曲线的画法。在EXCEL生成坐标X,Y列；X为分段值控制曲线精度，Y为计算的对应值； 2.假定EXCEL中X数值在A列，Y数值在B列，生成ACAD的PLINE绘图数据，方法如下： (1)在新的列单元（如C列）输入公式：=An&","&Bn（n为数据的行号），按次办法将An及Bn单元格中的数据在Cn单元格中形成(x,y)的形式。关键是生成逗号。 (2)拷贝Cn的公式(Cn单元格按CTRL拖动)，形成绘图数据列。 (3)拷贝绘图数据列（C列中的数据）。 3.在ACAD中执行PLINE命令，输入PL回车后的命令行处按鼠标的右键，选粘贴命令，将从EXCEL中拷贝的数据粘贴到此处。 4.搞定（PL命令按x1,y1...x2,y2...xn,yn的形式绘制曲线。） 可以直接画，先三点画一水平pline线，起、终对应抛物线端点，其中间点高为2倍抛物线的矢高即2f，同时将cad的splintype参数设为5。对该plnie进行编辑，选择spline项，生成的pline曲线即为您要的抛物线。注意，为了精度，可将splinesegs参数调高。