用Cad画二次抛物线文档格式.doc
- 文档编号:13264501
- 上传时间:2022-10-09
- 格式:DOC
- 页数:4
- 大小:18.50KB
用Cad画二次抛物线文档格式.doc
《用Cad画二次抛物线文档格式.doc》由会员分享,可在线阅读,更多相关《用Cad画二次抛物线文档格式.doc(4页珍藏版)》请在冰豆网上搜索。
DimaAsDouble
DimbAsDouble
DimcAsDouble
设抛物线的宽度为l
DimlAsDouble
DimpAsDouble
DimCoAsAcad3DSolid
DimSeAsAcadRegion
DimPaAsAcad3DFace
DimPntAsAcadPoint
DimSp()AsAcadObject
a=InputBox("
请输入y=a*x*x+b*x+c中对应的a:
"
"
抛物线方程参数"
)
Ifa=0ThenMsgBox"
a=0,不是抛物线"
:
End
b=InputBox("
请输入y=a*x*x+b*x+c中对应的b:
c=InputBox("
请输入y=a*x*x+b*x+c中对应的c:
)
l=InputBox("
请输入所要画的抛物线宽度l:
抛物线宽度"
l=l/2
计算x²
=2py中的p
p=1/Abs(a)
定义O点
pntO(0)=0
pntO
(1)=0
pntO
(2)=0
定义A点pntA(0)=0
pntA
(1)=0
pntA
(2)=l*Sqr(3)/2
画圆锥
SetCo=ThisDrawing.ModelSpace.AddCone(pntO,l,l*Sqr(3))
移动圆锥,使底部圆在xy平面上Co.MovepntO,pntA
Ifl>
p/2Then
pntA
(1)=p/2
pntA
(2)=(l-p/2)*Sqr(3)
定义B点
pntB(0)=0
pntB
(1)=-l+p
pntB
(2)=0
定义C点
pntC(0)=1
pntC
(1)=-l+p
pntC
(2)=0
画剥面线
SetSe=Co.SectionSolid(pntA,pntB,pntC)
剥面线旋转到xy平面
Se.Rotate3DpntB,pntC,-60*4*Atn
(1)/180
定义D点
pntD(0)=0
pntD
(1)=-l
pntD
(2)=0
定义E点
pntE(0)=1
pntE
(1)=0
pntE
(2)=0
移动剥面线,使顶点在(0,0,0)位置
Se.MovepntO,pntD
当a>
0时,翻转曲线
Ifa>
0ThenSe.Rotate3DpntO,pntE,180*4*Atn
(1)/180
重新设E点
pntE(0)=-b/(2*a)
pntE
(1)=(4*a*c-b^2)/(4*a)
移抛物线
Se.MovepntO,pntE
炸开剥面线
Sp=Se.Explode
删除辅助内容
Co.Delete
Se.Delete
Sp
(1).Delete
Else
MsgBox"
输入的l太小,不适合剥圆锥"
EndIf
EndSub
第三步菜单栏里点击运行命令输入参数abc以及抛物线宽度即可得到
CAD和ExcelVBA高手请进批量获取坐标点数据
一次出差到一个项目工地去,看到他们对着电脑上设计单位给的CAD图在一个点一个点的的找坐标值.方法是用鼠标点上一个点,记下(X,Y)后再输到EXCEL中,怕一个人出错,得两个人来操作.后来有人发现了一个好办法,说不用笔来记(X,Y)了,直接用复制和粘贴的办法来做,这确实是一大进步呀.我问他们这一晚上能找多少点呀,回答说做不了多少还老出错.我说这样吧我给你编一个小程序用吧.一晚过后第二天他们拿程序一用都说真是省大劲了,又准又快呀.
在CAD中选工具--宏--visualbasic编辑器,点thisdrawing把下面的程序写进去,然后点运行即可.
AttributeVB_Name="
模块1"
Subabc()
Dimx,yAsDouble
DimReturnPointAsVariant
DimiAsInteger
DimhighAsSingle
DimPtext,FnameAsString
DimtextObjAsAcadText
DimpointObjAsAcadPoint
DimlayerObjAsAcadLayer
x=0:
y=0:
i=1:
high=9
Fname=InputBox("
选取结束时,请回到第一点!
请给出文件名。
)
IfFname="
ThenFname="
PointsDate"
Fname="
c:
\abc\"
&
Fname&
"
.txt"
SetlayerObj=ThisDrawing.Layers.Add("
PointsData"
ReturnPoint=ThisDrawing.Utility.GetPoint
Ptext=i&
("
Round(ReturnPoint(0),2)&
"
Round(ReturnPoint
(1),2)&
)"
SettextObj=ThisDrawing.ModelSpace.AddText(Ptext,ReturnPoint,high)
SetpointObj=ThisDrawing.ModelSpace.AddPoint(ReturnPoint)
pointObj.Layer="
textObj.Layer="
pointObj.color=acRed
OpenFnameForOutputAs#1'
\PointsDATA.txt"
Print#1,"
No"
y"
x"
Print#1,i;
Round(ReturnPoint
(1),2),Round(ReturnPoint(0),2)
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Cad 二次 抛物线
![提示](https://static.bdocx.com/images/bang_tan.gif)