VB语言在CAD上计算机辅助几何设计习题汇编.docx
- 文档编号:18331921
- 上传时间:2023-08-15
- 格式:DOCX
- 页数:19
- 大小:17.74KB
VB语言在CAD上计算机辅助几何设计习题汇编.docx
《VB语言在CAD上计算机辅助几何设计习题汇编.docx》由会员分享,可在线阅读,更多相关《VB语言在CAD上计算机辅助几何设计习题汇编.docx(19页珍藏版)》请在冰点文库上搜索。
VB语言在CAD上计算机辅助几何设计习题汇编
创建点对象
Subch4_createpoint()
DimpointobjAsAcadPoint
Dimlocation(0To2)AsDouble
'定义点的位置
location(0)=5#:
location
(1)=5#:
location
(2)=0#
'创建点
Setpointobj=ThisDrawing.ModelSpace.AddPoint(location)
ThisDrawing.SetVariable"PDMODE",34
ThisDrawing.SetVariable"PDSIZE",1
ZoomAll
EndSub
打开图形
Subch3_opendrawing()
DimdwgnameAsString
dwgname="c:
\campus.dwg"
IfDir(dwgname)<>""Then
ThisDrawing.Application.Documents.Opendwgname
Else
MsgBox"file"&"doesnotexist."
EndIf
EndSub
创建多段线
SubCh4_AddLightWeightPolyline()
DimplineObjAsAcadLWPolyline
Dimpoints(0To5)AsDouble
'定义二维多段线的点
points(0)=2:
points
(1)=4
points
(2)=4:
points(3)=2
points(4)=6:
points(5)=4
'在模型空间中创建一个优化多段线对象
SetplineObj=ThisDrawing.ModelSpace._
AddLightWeightPolyline(points)
ThisDrawing.Application.ZoomAll
EndSub
创建和命名图层
Subch4_newlayer()
'创建圆
DimcircleobjAsAcadCircle
Dimcenter(0To2)AsDouble
DimradiusAsDouble
center(0)=2:
center
(1)=2:
center
(2)=0
radius=1
Setcircleobj=ThisDrawing.ModelSpace._
AddCircle(center,radius)
'创建颜色对象
DimcolAsNewAcadAcCmColor
col.ColorMethod=AutoCAD.acColorMethodForeground
'设置图层的颜色
DimlaycolorAsAcadAcCmColor
Setlaycolor=AcadApplication.GetInterfaceObject("autocad.accmcolor.16")
Calllaycolor.SetRGB(122,199,25)
ThisDrawing.ActiveLayer.turecolor=laycolor
col.ColorMethod=AutoCAD.acColorMethodByLayer
'将圆的颜色指定为"随层"
'以便圆自动拾取所在图层的
'颜色
circleobj.color=acByLayer
circleobj.Update
EndSub
创建面域
SubCh4_CreateRegion()
'定义保存面域边界
'的数组
Dimcenter(0To2)AsDouble
DimradiusAsDouble
center(0)=2
center
(1)=2
center
(2)=0
radius=5#
Setcurves(0)=ThisDrawing.ModelSpace.AddCircle(center,radius)
'创建面域
DimregionObjAsVariant
regionObj=ThisDrawing.ModelSpace.AddRegion(curves)
ZoomAll
EndSub
创建曲线
SubCh4_CreateSpline()
'本例在模型空间中创建样条曲线对象。
'声明所需的变量
DimsplineObjAsAcadSpline
DimstartTan(0To2)AsDouble
DimendTan(0To2)AsDouble
DimfitPoints(0To8)AsDouble
'定义变量
startTan(0)=0.5:
startTan
(1)=0.5:
startTan
(2)=0
endTan(0)=0.5:
endTan
(1)=0.5:
endTan
(2)=0
fitPoints(0)=1:
fitPoints
(1)=1:
fitPoints
(2)=0
fitPoints(3)=5:
fitPoints(4)=5:
fitPoints(5)=0
fitPoints(6)=10:
fitPoints(7)=0:
fitPoints(8)=0
'创建样条曲线
SetsplineObj=ThisDrawing.ModelSpace.AddSpline_
(fitPoints,startTan,endTan)
ZoomAll
EndSub
创建直线
SubExample_AddLine()
'Thisexampleaddsalineinmodlespace
DimlineObjAsAcadLine
DimstartPoint(0To2)AsDouble
DimendPoint(0To2)AsDouble
'Definethestartandendpointsfortheline
startPoint(0)=1#:
startPoint
(1)=1#:
startPoint
(2)=0#
endPoint(0)=5#:
endPoint
(1)=5#:
endPoint
(2)=0#
'Createthelineinmodelspace
SetlineObj=ThisDrawing.ModelSpace.AddLine(startPoint,endPoint)
ZoomAll
EndSub
创建圆并更改颜色
Subch4_colorcircle()
DimcolorAsAcadAcCmColor
Setcolor=_
AcadApplication.GetInterfaceObject("autocad.accmcolor.16")
Callcolor.SetRGB(80,100,244)
DimcircleobjAsAcadCircle
Dimcenterpoint(0To2)AsDouble
DimradiusAsDouble
centerpoint(0)=0#:
centerpoint
(1)=0#:
centerpoint
(2)=0#
radius=5#
Setcircleobj=_
ThisDrawing.ModelSpace.addciecle(centerpoint,radius)
circleobj.turecolor=color
ZoomAll
EndSub
创建圆
Subexample_addcircle()
'本例在模型空间中创建圆对象
'声明所需的变量
DimcircleobjAsAcadCircle
Dimcenterpoint(0To2)AsDouble
DimradiusAsDouble
'定义变量
centerpoint(0)=0#:
centerpoint
(1)=0#:
centerpoint
(2)=0#
radius=5#
'创建圆对象
Setcircleobj=ThisDrawing.ModelSpace.AddCircle(centerpoint,radius)
ZoomAll
EndSub
创建组合面域
SubCh4_CreateCompositeRegion()
'创建两个圆,一个代表房间,
'另一个代表房间中的柱子
DimRoomObjects(0To1)AsAcadCircle
Dimcenter(0To2)AsDouble
DimradiusAsDouble
center(0)=4
center
(1)=4
center
(2)=0
radius=2#
SetRoomObjects(0)=ThisDrawing.ModelSpace._
AddCircle(center,radius)
radius=1#
SetRoomObjects
(1)=ThisDrawing.ModelSpace._
AddCircle(center,radius)
'从这两个圆创建一个面域
DimregionAsVariant
region=ThisDrawing.ModelSpace.AddRegion(RoomObjects)
'将面域复制到面域变量中以便使用
DimroundroomobjAsAcadRegion
DimpillarobjAsAcadRegion
Ifregion(0).Area>region
(1).AreaThen
'第一个面域是房间
Setroundroomobj=region(0)
Setpillarobj=region
(1)
Else
'第一个面域是柱子
Setpillarobj=regions(0)
Setroundroomobj=regions
(1)
EndIf
'从地板空间减去柱子空间,
'已获得表示地毯总面积的面域。
roundroomobj.BooleanacSubtraction,pillarobj
'使用Area特性确定出地毯的总面积
MsgBox"thecarpetareais:
"&roundroomobj.Area
EndSub
打开和关闭图层
Subch4_layerinvisible()
'创建圆
DimcircleobjAsAcadCircle
Dimcenter(0To2)AsDouble
DimradiusAsDouble
center(0)=2:
center
(1)=2:
center
(2)=0
radius=1
Setcircleobj=ThisDrawing.ModelSpace._
AddCircle(center,radius)
'创建图层"ABC"
DimlayerobjAsAcadLayer
Setlayerobj=ThisDrawing.Layers.Add("ABC")
'将圆指定到"ABC"图层
circleobj.Layer="ABC"
circleobj.Update
'关闭图层"ABC"
layerobj.LayerOn=False
ThisDrawing.RegenacActiveViewport
EndSub
更改对象颜色
Subch4_colorcircle()
DimcolorAsAcadAcCmColor
Setcolor=AcadApplication.GetInterfaceObject("autocad.accmcolor.16")
Callcolor.SetRGB(80,100,244)
DimcircleobjAsAcadCircle
Dimcenterpoint(0To2)AsDouble
DimradiusAsDouble
centerpoint(0)=0#:
centerpoint
(1)=0#:
centerpoint
(2)=0#
radius=5#
Setcircleobj=_
ThisDrawing.ModelSpace.AddCircle(centerpoint,radius)
circleobj.turecolor=color
ZoomAll
EndSub
加载新图形
Subch3_newdrawing()
DimdocobjAsAcadDocument
Setdocobj=ThisDrawing.Application.Documents.Add
EndSub
十字光标全屏
Subch2_prefssetcursor()
'本例将AutoCAD图形的十字光标
'设置为全屏
'访问preferences对象
DimacadprefAsAcadPreferences
Setacadpref=ThisDrawing.Application.Preferences
'使用CursorSize特性设置十字光标的大小
acadpref.Display.CursorSize=100
EndSub
保存图形
Subch3_saveactivedrawing()
'用当前名称保存活动的图形
ThisDrawing.Save
'用新名称保存活动的图形
ThisDrawing.SaveAs"mydrawing.dwg"
EndSub
使用线型
Subch4_loadlinetype()
OnErrorGoToerrorhandler
DimlinetypenameAsString
linrtypename="CENTER"
'从acad.lin文件加载"CENTER"线型
ThisDrawing.Linetypes.Loadlinetypename,"acad.lin"
ExitSub
errorhandler:
MsgBoxErr.Description
EndSub
缩放图形(多段线)
Subch4_scalepolyline()
'创建多段线
DimplineobjAsAcadLWPolyline
Dimpoints(0To11)AsDouble
points(0)=1:
points
(1)=2
points
(2)=1:
points(3)=3
points(4)=2:
points(5)=3
points(6)=3:
points(7)=3
points(8)=4:
points(9)=4
points(10)=4:
points(11)=2
Setplineobj=ThisDrawing.ModelSpace._
addlightweighpolyline(points)
plineobj.Closed=ture
ZoomAll
'定义缩放
Dimbasepoint(0To2)AsDouble
DimscalefactorAsDouble
basepoint(0)=4:
basepoint
(1)=4.25:
basepoint
(2)=0
scalefactor=0.5
'缩放多段线
plineobj.ScaleEntitybasepoint,scalefactor
plineobj.Update
EndSub
显示屏幕滚动条
Subch2_prefssetdisplay()
'本例使用DisplayScreenMenu和DisplayScrollBars特性
'分别启用屏幕菜单和禁用
'滚动条。
'访问Preferences对象
DimacadprefAsAcadPreferences
Setacadpref=ThisDrawing.Application.Preferences
'显示屏幕菜单并禁用滚动条
acadpref.Display.DisplayScreenMenu=True
acadpref.Display.DisplayScrollBars=False
EndSub
写字(科比)
Subch4_createtext()
DimtextobjAsAcadText
DimtextstringAsString
Diminsertionpoint(0To2)AsDouble
DimheightAsDouble
'创建Text对象
textstring="科比"
insertionpoint(0)=2
insertionpoint
(1)=2
insertionpoint
(2)=0
height=0.5
Settextobj=ThisDrawing.ModelSpace._
AddText(textstring,insertionpoint,height)
textobj.Update
EndSub
修改对象线型
Subch4_changecirclelinetype()
OnErrorResumeNext
'创建圆
DimcircleobjAsAcadCircle
Dimcenter(0To2)AsDouble
DimradiusAsDouble
center(0)=2:
center
(1)=2:
center
(2)=0
radius=1
Setcircleobj=ThisDrawing.ModelSpace._
AddCircle(center,radius)
DimlinetypenameAsString
linetypename="CENTER"
'从acad.lin文件加载"CENTER"线型
ThisDrawing.Linetypes.Loadlinetypename,"acad.lin"
IfErr.Description<>""ThenMsgBoxErr.Description
'指定圆的线型为"CENTER"
circleobj.Linetype="CENTER"
circleobj.Update
EndSub
旋转图形(多段线)
Subch4_rotatepolyline()
'创建多段线
DimplineobjAsAcadLWPolyline
Dimpoints(0To11)AsDouble
points(0)=1:
points
(1)=2
points
(2)=1:
points(3)=3
points(4)=2:
points(5)=3
points(6)=3:
points(7)=3
points(8)=4:
points(9)=4
points(10)=4:
points(11)=2
Setplineobj=ThisDrawing.ModelSpace._
addlightweighpolyline(points)
plineobj.Closed=ture
ZoomAll
'定义绕点(4,4.25,0)旋转
'45度
Dimbasepoint(0To2)AsDouble
DimrotationangleAsDouble
basepoint(0)=4:
basepoint
(1)=4.25:
basepoint
(2)=0
rotationangle=0.7853981'45degrees
'旋转多段线
plineobj.Rotatebasepoint,rotationangle
plineobj.Update
EndSub
阵列图形(圆)
Subch4_arrayingacircle()
'创建圆
DimcircleobjAsAcadCircle
Dimcenter(0To2)AsDouble
DimradiusAsDouble
center(0)=2#:
center
(1)=2#:
center
(2)=0#
radius=1
Setcircleobj=ThisDrawing.ModelSpace._
AddCircle(center,radius)
ZoomAll
'定义环形阵列
DimnoofobjectsAsInteger
DimangletofillAsDouble
Dimbasepnt(0To2)AsDouble
noofobjects=4
angletofill=3.14'180度
basepnt(0)=4#:
basepnt
(1)=4#:
basepnt
(2)=0#
'下例通过绕点(3,3,0)旋转和
'复制对象而创建四个
'对象副本
DimretobjAsVariant
retobj=circleobj.ArrayPolar_
(noofobjects,angletofill,basepnt)
ZoomAll
EndSub
偏移图形(多段线)
Subch4_offpolyline()
'创建多段线
DimplineobjAsAcadLWPolyline
Dimpoint(0To11)AsDouble
points(0)=1:
points
(1)=1
points
(2)=1:
points(3)=2
points(4)=2:
points(5)=2
points(6)=3:
points(7)=2
point
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VB 语言 CAD 计算机辅助 几何 设计 习题 汇编