



下载本文档
版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领
文档简介
本文格式为Word版,下载可任意编辑——用Cad画二次抛物线Cad画二次抛物线如
第一步确认cad中有假使没有请下载,即CAD中“工具〞→“宏〞→“visualbasic编辑器〞,点thisdrawing其次步开启开启VBA窗口添加模块复制以下Subpwx()'定义几个点
DimpntO(2)AsDoubleDimpntA(2)AsDoubleDimpntB(2)AsDoubleDimpntC(2)AsDoubleDimpntD(2)AsDoubleDimpntE(2)AsDouble
'设抛物线方程为:y=ax2+bx+cDimaAsDoubleDimbAsDoubleDimcAsDouble'设抛物线的宽度为lDimlAsDoubleDimpAsDouble
DimCoAsAcad3DSolidDimSeAsAcadRegionDimPaAsAcad3DFaceDimPntAsAcadPointDimSp()AsAcadObject
a=InputBox(\请输入y=a*x*x+b*x+c中对应的a:\抛物线方程参数\Ifa=0ThenMsgBox\不是抛物线\
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'计算x2=2py中的pp=1/Abs(a)'定义O点pntO(0)=0pntO(1)=0pntO(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,pntAIfl>p/2Then
'定义A点pntA(0)=0pntA(1)=p/2
pntA(2)=(l-p/2)*Sqr(3)'定义B点pntB(0)=0pntB(1)=-l+ppntB(2)=0'定义C点pntC(0)=1pntC(1)=-l+ppntC(2)=0'画剥面线
SetSe=Co.SectionSolid(pntA,pntB,pntC)'剥面线旋转到xy平面
Se.Rotate3DpntB,pntC,-60*4*Atn(1)/180
'定义D点pntD(0)=0pntD(1)=-lpntD(2)=0'定义E点pntE(0)=1pntE(1)=0pntE(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)pntE(2)=0'移抛物线
Se.MovepntO,pntE'炸开剥面线Sp=Se.Explode'删除辅助内容Co.Delete
Se.DeleteSp(1).Delete
Else
MsgBox\输入的l太小,不适合剥圆锥\EndIf
EndSub
第三步菜单栏里点击运行命令输入参数
以及抛物线宽度即可得到
CAD和ExcelVBA高手请进批量获取坐标点数据
一次出差到一个项目工地去,看到他们对着电脑上设计单位给的CAD图在一个点一个点的的找坐标值.方法是用鼠标点上一个点,记录下来(X,Y)后再输到EXCEL中,怕一个人出错,得两个人来操作.后来有人发现了一个好方法,说不用笔来记(X,Y)了,直接用复制和粘贴的方法来做,这确实是一大进步呀.我问他们这一晚上能找多少点呀,回复说做不了多少还老出错.我说这样吧我给你编一个小程序用吧.一晚过后其次天他们拿程序一用都说真是省大劲了,又准又快呀.
在CAD中选工具--宏--visualbasic编辑器,点thisdrawing把下面的程序写进去,然后点运行即可.
AttributeVB_Name=\模块1\Subabc()
Dimx,yAsDouble
DimReturnPointAsVariantDimiAsIntegerDimhighAsSingle
DimPtext,FnameAsStringDimtextObjAsAcadTextDimpointObjAsAcadPointDimlayerObjAsAcadLayerx=0:y=0:i=1:high=9
Fname=InputBox(\选取终止时,请回到第一点!请给出文件名。\IfFname=\Fname=\
SetlayerObj=ThisDrawing.Layers
温馨提示
- 1. 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
- 2. 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
- 3. 本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
- 4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
- 5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
- 6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
- 7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。
最新文档
- 智慧城市服务中智能停车系统的商业模式
- 媒体融合下的教育品牌传播新模式
- 心理健康干预在校园教育中的实践与探索
- 抖音商户直播库存同步更新管理制度
- 抖音商户预算外支出特别审批流程制度
- 八大行业物流成本控制与交通运输优化方案研究报告
- 公交优先视角下城市交通拥堵治理的公共交通出行行为引导研究报告
- 2024-2025学年广西陆川县联考数学七上期末调研模拟试题含解析
- 公共交通优化:2025年智慧交通系统交通流量预测技术应用分析报告
- 陕西省榆林市定边县2024年九上化学期末达标测试试题含解析
- 《电线电缆培训》课件
- 重危患者护理计划的制定与实施
- 曾仕强讲易经的奥秘(PPT)
- 铜杆生产工艺流程介绍
- 北京通州玉桥中学小升初分班考试数学
- GB3956-97电缆的导体
- 外墙石材维修施工方案
- 国家开放大学《水利水电工程造价管理》形考任务1-4参考答案
- 第二临床医学院审核评估自评报告
- 广东省义务教育教育阶段学生学籍卡
- LOESCHE RAW MILLS 莱歇原料立磨_图文
评论
0/150
提交评论