cad中精准抛物线画法.docx

cad中精准抛物线画法.docx

《cad中精准抛物线画法.docx》由会员分享，可在线阅读，更多相关《cad中精准抛物线画法.docx（10页珍藏版）》请在冰豆网上搜索。

cad中精准抛物线画法

1.先用直线命令画一直线（图1）。

过程如下：

　　命令:

LINE

　　指定第一点:

0,0

　　指定下一点或[放弃（U）]:

'cal

　　>>表达式:

+[100*100/200<-30]

　　（43.3013-25.00.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。

完毕！

Subtrparabola（）

Dimbq1,bq2,pt1,pt2AsVariant

Dimaa,ll,yy,a1,a2,a3,a4,aa1,pt3（0To2）,bq4（0To2）AsDouble

Dimbq3（0To2）AsDouble

DimaeAsDouble

Dimpt33（0To2）AsDouble

Dimptarr（0To7）AsDouble

DimaltAsVariant

DimobjboltbAsAcad3DSolid

DimalAsVariant

DimlensAsAcadLWPolyline

'求个控制点

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）

'画多段线

Setlens=ThisDrawing.ModelSpace.AddLightWeightPolyline（ptarr）

Dimobjlist（0）AsAcadEntity

Setobjlist（0）=lens

'将多段线变为面域

DimaltregionAsAcadRegion

alt=ThisDrawing.ModelSpace.AddRegion（objlist）

objlist（0）.Delete

Setaltregion=alt（0）

'旋转面域得到圆锥

ae=2*Atn

（1）*4

Setobjboltb=ThisDrawing.ModelSpace.AddRevolvedSolid（altregion,pt1,pt33,ae）

altregion.Delete

'切圆锥得到抛物线

Setal=objboltb.SectionSolid（bq1,bq2,bq3）

objboltb.Delete

al.Rotatebq1,a1

al.Rotate3Dbq1,bq4,a3

DimexplodedobjectsAsVariant

explodedobjects=al.Explode

al.Delete

DimiAsInteger

DimkindAsString

DimparabolaobjectAsAcadSpline

Fori=0ToUBound（explodedobjects）

kind=explodedobjects（i）.ObjectName

Ifkind="AcDbLine"Then

   explodedobjects（i）.Delete

   Else

     Setparabolaobject=explodedobjects（i）

   EndIf

Next

'旋转抛物线

ThisDrawing.SendCommand"rotate"&vbCr&"（Handent"""¶bolaobject.Handle&"""）"&vbCr&""&vbCr&bq1（0）&","&bq1

（1）&vbCr

EndSub