cad中精准抛物线画法Word下载.docx

cad中精准抛物线画法Word下载.docx

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

　　（43.3013-25.00.0）

↙

　　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"

"

parabolaobject.Handle&

）"

bq1（0）&

"

bq1

（1）&

vbCr

EndSub