机械CAD第三次报告.docx
《机械CAD第三次报告.docx》由会员分享，可在线阅读，更多相关《机械CAD第三次报告.docx（13页珍藏版）》请在冰豆网上搜索。
机械CAD第三次报告
ParametricDrawingReport
Name:
..........
StudentNo.:
............
Expectingscore:
90
ChinaUniversityofGeosciences
Project:
Programmingfordrawascrew,screwboltorothergraphicsbyusingVLISP,VBA,ObjectARXetc..
一、TheObjectofDesign:
1.1、ThedesignisbasedonVBAasatoolforscrewparameterdesign.Reference"mechanicaldrawing"textbooks,slottedcheeseheadscrewsofthepartialtableasTheChartShows1-1
螺纹规格d
M5
M6
M8
M10
M12
M14
P（螺距）
0.8
1
1.25
1.5
1.75
2
B（参考）
22
24
28
32
36
40
8.5
10
13
16
18
21
k
5
6
8
10
12
14
t
2.5
3
4
5
6
7
s
4
5
6
8
10
12
r
0.2
0.25
0.4
0.4
0.6
0.6
公称长度l
8~50
10~60
12~80
16~100
20~120
25~140
L≤表中数值时
25
30
35
40
45
55
l系列
5，6，8，10，12，16，20，25，30，35，40，45，50，
55，60，65，70，80……
figure1-1
1.2、Method:
Takep0forpositioningpoint,accordingtothetable,selectthescrewdiameterDandnominallengthofLdata,determinethescrewsofthe,k，n，tparameters.Thescrewpointsidentified,wiredgenerationscrewCADdiagram,asillustratedinthefigure1-2.
figure1-2
二、processofprogramming
2.1、OpentheMicrosoftVisualBasiceditorasfigured2-1（a）/（b）.
figured2-1（a）
figured2-1（b）
2.2、Createauserwindowasfigured2-2.
figured2-2
2.3、InsertPictureasfigured2-3.
figured2-3
2.4、Edittheuserwindowasfigured2-4.
figured2-4
2.5、Programasfigured2-6（a）/（b）/（c）/（d）.
figured2-5（a）
figured2-5（b）
figured2-5（c）
figured2-5（d）
2.6、Toloaddotdashlineasfigured2-6.
figure2-6
2.7、ClickRunastheillustratedfigure2-7（a）/（b）.
figure2-7（a）
figure2-7（b）
2.8、Inputthedata,asillustratedfigure2-8.
figure2-8
2.9、Press“qued”，thenwewillgetaboltthatweexpectasfigure2-9.
figure2-9
3、Program:
PrivateSubCommandButton1_Click（）
DimCulineAsAcadLine'定义直线的对象变量
DimXilineAsAcadLine
DimDhlineAsAcadLine
Dimp0（0To2）AsDouble
DimdAsVariant
DimLAsVariant'定义三个变体变量
Dimp1（0To2）AsDouble'定义保存点的双精度数组
Dimp2（0To2）AsDouble
Dimp3（0To2）AsDouble
Dimp4（0To2）AsDouble
Dimp5（0To2）AsDouble
Dimp6（0To2）AsDouble
Dimp7（0To2）AsDouble
Dimp8（0To2）AsDouble
Dimp9（0To2）AsDouble
Dimp10（0To2）AsDouble
Dimp11（0To2）AsDouble
Dimp12（0To2）AsDouble
Dimp13（0To2）AsDouble
Dimp14（0To2）AsDouble
Dimp15（0To2）AsDouble
Dimp16（0To2）AsDouble
Dimp17（0To2）AsDouble
Dimp18（0To2）AsDouble
Dimpt1（0To2）AsDouble
Dimpt2（0To2）AsDouble
'线型的添加
DimentryAsAcadLineType:
DimfoundAsBoolean:
DimltName（0To2）AsString
DimiAsInteger
found=False
'准备添加的3种线型
ltName（0）="BORDER"
ltName
（1）="CENTER"
ltName
（2）="DASHDOT"
Fori=0To2
'搜寻要添加的线型在线型集合中是否已存在
ForEachentryInThisDrawing.Linetypes
IfStrComp（entry.Name,ltName（i）,1）=0Then
found=True
ExitFor
EndIf
Next
'如果不存在则将其从线型文件acadiso.lin中加载
IfNot（found）Then
ThisDrawing.Linetypes.LoadltName（i）,"acadiso.lin"
EndIf
Next
'创建图层
DimobjLayerAsAcadLayer
'粗实线
SetobjLayer=ThisDrawing.Layers.Add（"粗实线"）
objLayer.color=acWhite
objLayer.Linetype="Continuous"
objLayer.Lineweight=acLnWt030
ThisDrawing.ActiveLayer=objLayer
p0（0）=Val（TextBox1.Text）'输入螺钉定点的X坐标
p0
（1）=Val（TextBox2.Text）'输入螺钉定点的Y坐标
p0
（2）=0
d=Val（TextBox3.Text）'输入螺钉的直径
L=Val（TextBox4.Text）'输入螺钉的长度
p1（0）=p0（0）:
p1
（1）=p0
（1）+0.1*d:
p1
（2）=p0
（2）'计算各个点
p2（0）=p0（0）:
p2
（1）=p0
（1）-0.1*d:
p2
（2）=p0
（2）
p3（0）=p1（0）-0.2*d:
p3
（1）=p1
（1）:
p3
（2）=p1
（2）
p4（0）=p2（0）-0.2*d:
p4
（1）=p2
（1）:
p4
（2）=p2
（2）
p5（0）=p3（0）:
p5
（1）=p3
（1）+1.4*d:
p5
（2）=p3
（2）
p6（0）=p4（0）:
p6
（1）=p4
（1）-1.4*d:
p6
（2）=p4
（2）
p7（0）=p5（0）+0.8*d:
p7
（1）=p5
（1）:
p7
（2）=p5
（2）
p8（0）=p6（0）+0.8*d:
p8
（1）=p6
（1）:
p8
（2）=p6
（2）
p9（0）=p7（0）:
p9
（1）=p7
（1）-0.25*d:
p9
（2）=p7
（2）
p10（0）=p8（0）:
p10
（1）=p8
（1）+0.25*d:
p10
（2）=p8
（2）
p11（0）=p9（0）+0.125*d:
p11
（1）=p9
（1）:
p11
（2）=p9
（2）
p12（0）=p10（0）+0.125*d:
p12
（1）=p10
（1）:
p12
（2）=p10
（2）
p13（0）=p11（0）:
p13
（1）=p11
（1）-0.075*d:
p13
（2）=p11
（2）
p14（0）=p12（0）:
p14
（1）=p10
（1）+0.075*d:
p14
（2）=p12
（2）
p15（0）=p9（0）+L-0.075*d:
p15
（1）=p9
（1）:
p15
（2）=p11
（2）
p16（0）=p10（0）+L-0.075*d:
p16
（1）=p10
（1）:
p16
（2）=p12
（2）
p17（0）=p9（0）+L:
p17
（1）=p13
（1）:
p17
（2）=p13
（2）
p18（0）=p10（0）+L:
p18
（1）=p14
（1）:
p18
（2）=p14
（2）
pt1（0）=p0（0）-0.2*d-7:
pt1
（1）=p0
（1）:
pt1
（2）=p0
（2）
pt2（0）=p0（0）+0.6*d+L+7:
pt2
（1）=p0
（1）:
pt2
（2）=p0
（2）
SetCuline=ThisDrawing.ModelSpace.AddLine（p0,p1）'画出直线
SetCuline=ThisDrawing.ModelSpace.AddLine（p0,p2）
SetCuline=ThisDrawing.ModelSpace.AddLine（p1,p3）
SetCuline=ThisDrawing.ModelSpace.AddLine（p2,p4）
SetCuline=ThisDrawing.ModelSpace.AddLine（p3,p5）
SetCuline=ThisDrawing.ModelSpace.AddLine（p4,p6）
SetCuline=ThisDrawing.ModelSpace.AddLine（p5,p7）
SetCuline=ThisDrawing.ModelSpace.AddLine（p6,p8）
SetCuline=ThisDrawing.ModelSpace.AddLine（p7,p8）
SetCuline=ThisDrawing.ModelSpace.AddLine（p9,p15）
SetCuline=ThisDrawing.ModelSpace.AddLine（p10,p16）
SetCuline=ThisDrawing.ModelSpace.AddLine（p11,p12）
SetCuline=ThisDrawing.ModelSpace.AddLine（p17,p18）
SetCuline=ThisDrawing.ModelSpace.AddLine（p15,p17）
SetCuline=ThisDrawing.ModelSpace.AddLine（p16,p18）
SetCuline=ThisDrawing.ModelSpace.AddLine（p15,p16）
'细实线
SetobjLayer=ThisDrawing.Layers.Add（"细实线"）
objLayer.color=acWhite
objLayer.Linetype="Continuous"
objLayer.Lineweight=acLnWt009
ThisDrawing.ActiveLayer=objLayer
SetXiline=ThisDrawing.ModelSpace.AddLine（p13,p17）
Xiline.Linetype="ByLayer"
SetXiline=ThisDrawing.ModelSpace.AddLine（p14,p18）
Xiline.Linetype="ByLayer"
'点划线
SetobjLayer=ThisDrawing.Layers.Add（"点划线"）
objLayer.color=acRed
objLayer.Linetype="CENTER2"
objLayer.Lineweight=acLnWt009
ThisDrawing.ActiveLayer=objLayer
SetDhline=ThisDrawing.ModelSpace.AddLine（pt1,pt2）
Dhline.Linetype="ByLayer"
EndSub
PrivateSubLabel2_Click（）
UnloadMe
EndSub
升级会员 