VBA二次开发Word文档格式.docx
- 文档编号:15905956
- 上传时间:2022-11-17
- 格式:DOCX
- 页数:14
- 大小:708.72KB
VBA二次开发Word文档格式.docx
《VBA二次开发Word文档格式.docx》由会员分享,可在线阅读,更多相关《VBA二次开发Word文档格式.docx(14页珍藏版)》请在冰豆网上搜索。
DimPXAsDouble'
定义存储点的变量
DimPYAsDouble
DimP2AsVariant
SubCommandButton1_Click()
'
将控制权交给AutoCAD
UserForm1.Hide
获取点的位置
P2=ThisDrawing.Utility.GetPoint(,"
指定点:
"
)
PX=P2(0)
PY=P2
(1)
TextBox13=P2(0)
TextBox14=P2
(1)
返回对话框
UserForm1.Show
EndSub
PrivateSubquxiao_Click()
ZoomExtents
End
Subyes_Click()
定义所需要的变量
DimdkAsDouble
DimnAsDouble
DimkAsDouble
DimtAsDouble
DimLAsDouble
DimL1AsDouble
DimdAsDouble
DimplineObj(0To9,0To2)AsAcadLine'
定义一个二维数组,存储所画的直线
DimiAsInteger'
定义循环控制变量
DimjAsInteger
DimP0(0To2)AsDouble
DimP1(0To2)AsDouble
初始化
dk=TextBox1
n=TextBox2
k=TextBox12
t=TextBox9
L=TextBox8
L1=TextBox11
d=TextBox10
P0(0)=PX
P0
(1)=PY
P1(0)=PX
P1
(1)=PY
开始计算绘图
画中心线
OnErrorResumeNext
ThisDrawing.Linetypes.Load"
CENTER"
"
acad.lin"
ThisDrawing.ActiveLinetype=ThisDrawing.Linetypes.Item("
SetplineObj(0,0)=AddLineReXY(P0,1.3*L,0)
SetplineObj(0,1)=AddLineReXY(P0,-0.2*L,0)
(1)
CONTINUOUS"
SetplineObj(1,0)=AddLineReXY(P0,0,n/2)
SetplineObj(1,1)=AddLineReXY(P1,0,-n/2)
P0
(1)=P0
(1)+n/2
P1
(1)=P1
(1)-n/2
(2)
SetplineObj(2,0)=AddLineReXY(P0,-k,0)
P0(0)=P0(0)-k
SetplineObj(2,1)=AddLineReXY(P1,-k,0)
P1(0)=P1(0)-k
(3)
SetplineObj(3,0)=AddLineReXY(P0,0,(dk/2-n/2))
P0
(1)=P0
(1)+(dk/2-n/2)
SetplineObj(3,1)=AddLineReXY(P1,0,-(dk/2-n/2))
P1
(1)=P1
(1)-(dk/2-n/2)
(4)
SetplineObj(4,0)=AddLineReXY(P0,t,0)
P0(0)=P0(0)+t
SetplineObj(4,1)=AddLineReXY(P1,t,0)
P1(0)=P1(0)+t
(5)
SetplineObj(5,0)=AddLineReXY(P0,0,-dk/2)
P0
(1)=P0
(1)+(d/2-dk/2)
SetplineObj(5,1)=AddLineReXY(P1,0,dk/2)
P1
(1)=P1
(1)-(d/2-dk/2)
(6)
SetplineObj(6,0)=AddLineReXY(P0,L,0)
P0(0)=P0(0)+L
SetplineObj(6,1)=AddLineReXY(P1,L,0)
P1(0)=P1(0)+L
(7)
SetplineObj(7,0)=AddLineReXY(P0,0,-d/2)
P0
(1)=P0
(1)-d/2
P0(0)=P0(0)-L1
SetplineObj(7,1)=AddLineReXY(P1,0,d/2)
P1
(1)=P1
(1)+d/2
P1(0)=P1(0)-L1
(8)
SetplineObj(8,0)=AddLineReXY(P0,0,d/2)
P0
(1)=P0
(1)+d/2-1
SetplineObj(8,1)=AddLineReXY(P0,L1,0)
SetplineObj(9,0)=AddLineReXY(P1,0,-d/2)
P1
(1)=P1
(1)-d/2+1
SetplineObj(9,1)=AddLineReXY(P1,L1,0)
plineObj(0,0).Lineweight=acLnWt009
plineObj(0,1).Lineweight=acLnWt009
plineObj(0,0).ScaleEntityP2,suofang
plineObj(0,0).Update
plineObj(0,1).ScaleEntityP2,suofang
plineObj(0,1).Update
plineObj(0,1).color=zs'
指定中心线的颜色zs代表中心线颜色
plineObj(0,0).color=zs'
指定中心线的颜色
Fori=1To10Step1'
循环对螺钉直线进行操作,两层循环
Forj=0To1Step1
plineObj(i,j).Lineweight=acLnWt030'
指定螺钉线宽
plineObj(i,j).color=ls'
指定螺钉线的颜色ls代表螺钉线颜色
plineObj(i,j).ScaleEntityP2,suofang'
指定螺钉缩放比例
plineObj(i,j).Update
Nextj
Nexti
ZoomExtents
Finally,designingamodule,thismodulecontainsrequiredfunction.
OptionExplicit
PublicSubAlternation()'
创建显示窗口和隐藏窗口的函数
UserForm1.Hind
'
创建直线的基准函数
PublicFunctionAddLine(ByValptStAsVariant,ByValptEnAsVariant)AsAcadLine
SetAddLine=ThisDrawing.ModelSpace.AddLine(ptSt,ptEn)
EndFunction
根据另一点的相对直角坐标创建直线
PublicFunctionAddLineReXY(ByValptStAsVariant,ByValxAsDouble,ByValyAsDouble)AsAcadLine
定义终点
DimptEnAsVariant
ptEn=GetPoint(ptSt,x,y)
SetAddLineReXY=AddLine(ptSt,ptEn)
获得相对已经点偏移一定距离的点
PublicFunctionGetPoint(ptAsVariant,xAsDouble,yAsDouble)AsVariant
DimptTarget(0To2)AsDouble
ptTarget(0)=pt(0)+x
ptTarget
(1)=pt
(1)+y
ptTarget
(2)=0
GetPoint=ptTarget
4.Runningresults:
Loadtheproject
Runthisproject,typingtheParametersoftheboltasfollow
Pickapointasthefirstpoint
Click"
确定"
取消"
退出程序
Differenttypingsleadtodifferentresult
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VBA 二次开发