VB语言在CAD上计算机辅助几何设计习题汇编

创建点对象Sub ch4_createpoint()Dim pointobj As AcadPointDim location(0 To 2) As Double'定义点的位置location(0) = 5#: location(1) = 5#: location(2) = 0#'创建点Set pointobj = ThisDrawing.ModelSpace.AddPoint(location) ThisDrawing.SetVariable "PDMODE", 34ThisDrawing.SetVariable "PDSIZE", 1ZoomAllEnd Sub打开图形Sub ch3_opendrawing()Dim dwgname As Stringdwgname = "c:\campus.dwg"If Dir(dwgname) <> "" ThenThisDrawing.Application.Documents.Open dwgname ElseMsgBox "file" & " does not exist."End IfEnd Sub创建多段线Sub Ch4_AddLightWeightPolyline()Dim plineObj As AcadLWPolylineDim points(0 To 5) As Double' 定义二维多段线的点points(0) = 2: points(1) = 4points(2) = 4: points(3) = 2points(4) = 6: points(5) = 4' 在模型空间中创建一个优化多段线对象Set plineObj = ThisDrawing.ModelSpace. _AddLightWeightPolyline(points) ThisDrawing.Application.ZoomAllEnd Sub创建和命名图层Sub ch4_newlayer()' 创建圆Dim circleobj As AcadCircleDim center(0 To 2) As DoubleDim radius As Doublecenter(0) = 2: center(1) = 2: center(2) = 0radius = 1Set circleobj = ThisDrawing.ModelSpace. _AddCircle(center, radius)'创建颜色对象Dim col As New AcadAcCmColorcol.ColorMethod = AutoCAD.acColorMethodForeground'设置图层的颜色Dim laycolor As AcadAcCmColorSet laycolor = AcadApplication.GetInterfaceObject("autocad.accmcolor.16") Call laycolor.SetRGB(122, 199, 25)ThisDrawing.ActiveLayer.turecolor = laycolorcol.ColorMethod = AutoCAD.acColorMethodByLayer'将圆的颜色指定为"随层"'以便圆自动拾取所在图层的'颜色circleobj.color = acByLayercircleobj.UpdateEnd Sub创建面域Sub Ch4_CreateRegion()' 定义保存面域边界' 的数组Dim center(0 To 2) As DoubleDim radius As Doublecenter(0) = 2center(1) = 2center(2) = 0radius = 5#Set curves(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)' 创建面域Dim regionObj As VariantregionObj = ThisDrawing.ModelSpace.AddRegion(curves) ZoomAllEnd Sub创建曲线Sub Ch4_CreateSpline()' 本例在模型空间中创建样条曲线对象。

' 声明所需的变量Dim splineObj As AcadSplineDim startTan(0 To 2) As DoubleDim endTan(0 To 2) As DoubleDim fitPoints(0 To 8) As Double' 定义变量startTan(0) = 0.5: startTan(1) = 0.5: startTan(2) = 0endTan(0) = 0.5: endTan(1) = 0.5: endTan(2) = 0fitPoints(0) = 1: fitPoints(1) = 1: fitPoints(2) = 0fitPoints(3) = 5: fitPoints(4) = 5: fitPoints(5) = 0fitPoints(6) = 10: fitPoints(7) = 0: fitPoints(8) = 0' 创建样条曲线Set splineObj = ThisDrawing.ModelSpace.AddSpline _(fitPoints, startTan, endTan) ZoomAllEnd Sub创建直线Sub Example_AddLine()' This example adds a line in modle spaceDim lineObj As AcadLineDim startPoint(0 To 2) As DoubleDim endPoint(0 To 2) As Double' Define the start and end points for the linestartPoint(0) = 1#: startPoint(1) = 1#: startPoint(2) = 0#endPoint(0) = 5#: endPoint(1) = 5#: endPoint(2) = 0#' Create the line in model spaceSet lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint) ZoomAllEnd Sub创建圆并更改颜色Sub ch4_colorcircle()Dim color As AcadAcCmColorSet color = _AcadApplication.GetInterfaceObject("autocad.accmcolor.16")Call color.SetRGB(80, 100, 244)Dim circleobj As AcadCircleDim centerpoint(0 To 2) As DoubleDim radius As Doublecenterpoint(0) = 0#: centerpoint(1) = 0#: centerpoint(2) = 0#radius = 5#Set circleobj = _ThisDrawing.ModelSpace.addciecle(centerpoint, radius)circleobj.turecolor = colorZoomAllEnd Sub创建圆Sub example_addcircle()'本例在模型空间中创建圆对象'声明所需的变量Dim circleobj As AcadCircleDim centerpoint(0 To 2) As DoubleDim radius As Double'定义变量centerpoint(0) = 0#: centerpoint(1) = 0#: centerpoint(2) = 0#radius = 5#'创建圆对象Set circleobj = ThisDrawing.ModelSpace.AddCircle(centerpoint, radius) ZoomAll创建组合面域Sub Ch4_CreateCompositeRegion()'创建两个圆，一个代表房间，'另一个代表房间中的柱子Dim RoomObjects(0 To 1) As AcadCircleDim center(0 To 2) As DoubleDim radius As Doublecenter(0) = 4center(1) = 4center(2) = 0radius = 2#Set RoomObjects(0) = ThisDrawing.ModelSpace. _AddCircle(center, radius) radius = 1#Set RoomObjects(1) = ThisDrawing.ModelSpace. _AddCircle(center, radius) '从这两个圆创建一个面域Dim region As Variantregion = ThisDrawing.ModelSpace.AddRegion(RoomObjects)'将面域复制到面域变量中以便使用Dim roundroomobj As AcadRegionDim pillarobj As AcadRegionIf region(0).Area > region(1).Area Then'第一个面域是房间Set roundroomobj = region(0)Set pillarobj = region(1)Else' 第一个面域是柱子Set pillarobj = regions(0)Set roundroomobj = regions(1)End If' 从地板空间减去柱子空间，'已获得表示地毯总面积的面域。

roundroomobj.Boolean acSubtraction, pillarobj'使用Area特性确定出地毯的总面积MsgBox "the carpet area is:" & roundroomobj.AreaEnd Sub打开和关闭图层Sub ch4_layerinvisible()'创建圆Dim circleobj As AcadCircleDim center(0 To 2) As DoubleDim radius As Doublecenter(0) = 2: center(1) = 2: center(2) = 0radius = 1Set circleobj = ThisDrawing.ModelSpace. _AddCircle(center, radius)'创建图层"ABC"Dim layerobj As AcadLayerSet layerobj = yers.Add("ABC")'将圆指定到"ABC"图层yer = "ABC"circleobj.Update'关闭图层"ABC"yerOn = FalseThisDrawing.Regen acActiveViewportEnd Sub更改对象颜色Sub ch4_colorcircle()Dim color As AcadAcCmColorSet color = AcadApplication.GetInterfaceObject("autocad.accmcolor.16") Call color.SetRGB(80, 100, 244)Dim circleobj As AcadCircleDim centerpoint(0 To 2) As DoubleDim radius As Doublecenterpoint(0) = 0#: centerpoint(1) = 0#: centerpoint(2) = 0#radius = 5#Set circleobj = _ThisDrawing.ModelSpace.AddCircle(centerpoint, radius)circleobj.turecolor = colorZoomAllEnd Sub加载新图形Sub ch3_newdrawing()Dim docobj As AcadDocumentSet docobj = ThisDrawing.Application.Documents.Add End Sub十字光标全屏Sub ch2_prefssetcursor()'本例将AutoCAD图形的十字光标'设置为全屏'访问preferences对象Dim acadpref As AcadPreferencesSet acadpref = ThisDrawing.Application.Preferences'使用CursorSize特性设置十字光标的大小acadpref.Display.CursorSize = 100End Sub保存图形Sub ch3_saveactivedrawing()'用当前名称保存活动的图形ThisDrawing.Save'用新名称保存活动的图形ThisDrawing.SaveAs "mydrawing.dwg"End Sub使用线型Sub ch4_loadlinetype()On Error GoTo errorhandlerDim linetypename As Stringlinrtypename = "CENTER"'从acad.lin文件加载"CENTER"线型ThisDrawing.Linetypes.Load linetypename, "acad.lin"Exit Suberrorhandler:MsgBox Err.DescriptionEnd Sub缩放图形（多段线）Sub ch4_scalepolyline()'创建多段线Dim plineobj As AcadLWPolylineDim points(0 To 11) As Doublepoints(0) = 1: points(1) = 2points(2) = 1: points(3) = 3points(4) = 2: points(5) = 3points(6) = 3: points(7) = 3points(8) = 4: points(9) = 4points(10) = 4: points(11) = 2Set plineobj = ThisDrawing.ModelSpace. _addlightweighpolyline(points)plineobj.Closed = tureZoomAll'定义缩放Dim basepoint(0 To 2) As DoubleDim scalefactor As Doublebasepoint(0) = 4: basepoint(1) = 4.25: basepoint(2) = 0 scalefactor = 0.5'缩放多段线plineobj.ScaleEntity basepoint, scalefactorplineobj.UpdateEnd Sub显示屏幕滚动条Sub ch2_prefssetdisplay()'本例使用DisplayScreenMenu 和DisplayScrollBars 特性'分别启用屏幕菜单和禁用'滚动条。