1、cad精准抛物线画法1.先用直线命令画一直线(图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 轴(
2、X)/Y 轴(Y):(捕捉A点)指定轴端点: (捕捉B点)指定旋转角度 :6.用SECTION命令切割三维实体,生成一个面域,如图6。过程如下:命令: SECTION选择对象: (选择上一步生成的旋转实体)选择对象: 指定截面上的第一个点,依照 对象(O)/Z 轴(Z)/视图(V)/XY 平面(XY)/YZ 平面(YZ)/ZX 平面(ZX)/三点(3) : yz指定 YZ 平面上的点 :(捕捉C点)7.用rotate3d命令对上一步生成的面域进行三维旋转,如图7。过程如下:命令: rotate3d当前正向角度: ANGDIR=逆时针 ANGBASE=0选择对象: (选择上一步生成的面域)选择对
3、象: 指定轴上的第一个点或定义轴依据对象(O)/最近的(L)/视图(V)/X 轴(X)/Y 轴(Y)/Z 轴(Z)/两点(2): (捕捉C点) 指定轴上的第二点:(捕捉D点)指定旋转角度或 参照(R): 908.先用EXPLODE命令分解旋转后的面域,再清理图面,删除不需要的图元,如图8。9.移动抛物线,如图9。完毕!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) A
4、s 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.GetDis
5、tance(, 输入开口弦长: ) 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(b
6、q1, 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
7、(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 Ac
8、adRegion 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.R
9、otate 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
copyright@ 2008-2022 冰豆网网站版权所有
经营许可证编号:鄂ICP备2022015515号-1