毕业设计 ---用VB开发交互式cad系统

合集下载

基于AutoCAD—VBA的对象交互式操作方法探讨

基于AutoCAD—VBA的对象交互式操作方法探讨VBA是一个AutoCAD应用程序集成开发环境，是一种面向对象的可视化结构编程语言，被广泛应用于各领域的实际工作中。

通过VBA对AutoCAD的二次开发，设计了一个对对象组合、拆散的应用程序，比较之前的命令行对话框的操作，提高了工作效率，实际应用效果良好。

标签：AutoCAD；VBA；对象；交互式1 概述AutoCAD中对象的组合拆散是一组常用操作，可以通过Group命令实现对对象的组合[1]，但组合拆散对象时必须都在对话框状态下进行，而且不能先选定后操作，操作不便捷[2]。

到了2002版本之后，AutoCAD菜单中甚至取消了这个命令。

但在实际绘图中，对象的组合、拆散功能队绘图有很大的帮助，因为在选择对象时，组合在一起的对象可以一次性选定而不需要逐个对象选择。

所以，通过编程实现快捷使用对象组合拆散功能，是这个程序编写的目的。

程序设计思路是去掉对话框，只要选定对象后输入一个相应的组合命令就可以直接将选定的对象综合在一起，而且不需要命名。

拆散对象也是同样的道理。

选定组合，输入拆散的命令就可以直接将组合在一起的对象拆散。

2 实例分析文章通过AutoCAD-VBA设计一个组合拆散对象的应用程序。

（1）运行AutoCAD2004，在【VBA管理器】对话框中新建一个全局工程[3]，进入VBA集成开发环境，将其名称修改为“匿名组”，保存在适当的位置上。

（2）在【工程资源管理器】窗口中双击ThisDrawing，打开该模块的代码窗口，首先其中添加对象组合的代码：Sub AddUnNameGroup（）Dim SelObjects As AcadSelectionSetDim ppendObjs（）As AcadEntitySet SelObjects=GetSelSetDim UnNameGroup As AcadGroupSet UnNameGroup=ThisDrawingGroups.Add（“*”）ReDim appendObjs（0 To SelObjects.Count-1）Dim I As IntegerFor i=0 To SelObjects.Count-1Set appendobjs（i）=SelObjects.Item（i）NextUnNameGroup.AppendItems appendobjsEnd Sub（3）在ThisDrawing模块的代码窗口中，添加通过选择对象所在的组，分解组的代码：Sub DelUnNameGroup（）Dim SelGroup As AcadGroupDim SelObjects As AcadSelectionSetSet SelObjects=GetSelSetDim ObjInSelSet As AcadObjectDim I As IntegerDim j As IntegerDim k As IntegerDim ObjInGroup As AcadObjectOn Error Resume NextFor i=0 To SelObjects.Count-1Set ObjInSelSet=SelObjects.Item（i）For j=0 To ThisDrawing.Groups. Count-1For k=0 To ThisDrawing.Groups.Item（j）. Count-1Set ObjInGroup=ThisDrawing.Groups.Item（j）.Item（k）If ObjInGroup.ObjectID=ObjInSelect.ObjectID ThenThisDrawing.Groups.Item（j）.DeleteExit ForEnd IfNextNextNextEnd Sub这段代码的实现过程由于不能通过选定的对象来直接找到其组合名称，只能通过循环比较对象ID的方法来解决这个问题。

05-AutoCAD VBA用户交互

Dim returnString As String
returnString = ThisDrawing.Utility.GetString(False, "Enter text (a space or <enter> terminates input): ")
returnString = ThisDrawing.Utility.GetString(True, "Enter text (<enter> terminates input):")
End Sub
（5）在命令窗口打印一行字符串Prompt
Prompt
Utility. Prompt Message
Example:
Sub Example_Prompt()
ThisDrawing.Utility.Prompt "Press any key..."
End Sub
（6）Utility对象的几个实用函数
交互：选择集与选择集的过滤
（2）排序（按照坐标或者相对中心点的位置）
大于的原则：对于行列排列：以x轴或者y轴优先，对于中心点环形排列：先判断半径，然后判断转角
（3）定位字符串的位置
问题：实现文字中心点与圆心对齐
3.2 选择集
3.2.1 什么是选择集
选择集是AutoCAD和用户操作的重要手段，与 GetEitity方法不同，选择集允许用户同时选择多个图形对象，同时提供了丰富的手段来选择符合特定条件的实体。
getanglegetangle与与getorientationgetorientationsubexamplegetangledimretangle获得弧度角度有用户提示信息输入retanglethisdrawingutilitygetangleenterangleenteredgetangle示例获得弧度角度没有用户提示信息输入retanglethisdrawingutilitygetanglemsgboxangleenteredgetangle示例获得弧度角度有用户提示信息输入与基本点输入dimbasepnt0doublebasepnt0thisdrawingutilitygetanglebasepntenterangleenteredgetangle示例获得弧度角度无用户提示信息输入但有基准点输入retanglethisdrawingutilitygetanglebasepntmsgboxangleenteredgetangle示例endsub22提示用户输入一个整数提示用户输入一个整数getintegergetinteger输入输入一个实数一个实数getrealgetreal和一个字符串和一个字符串getstringgetstringgetintegerretvalutilitygetintegerpromptgetrealretvalutilitygetrealpromptgetstringretvalutilitygetstringhasspacesprompt最多返回132个字符exampleexampledimreturnintintegerreturnintthisdrawingutilitygetintegerdimreturnrealdoublereturnrealthisdrawingutilitygetrealdimreturnstringstringreturnstringthisdrawingutilitygetstringfalseentertextenterterminatesinput

VB2012基于VB6.0开发交互式CAD系统

内容提要在交互式CAD系统中，不仅可以实现用鼠标绘图，还可以选择图元，并对选中的图元进行缩放、缩小、等操作。

在众多的交互式CAD开发工具中，VisualBasic是使用最简单、应用最广泛、使用者最多的一种开发工具，Visual Basic语言具备一定的绘图功能。

本设计的主要内容是在学习Visual Basic 语言和交互式CAD技术的基础上，运用Visual Basic语言来开发交互式CAD系统。

本系统具有交互绘图功能。

能实现鼠标绘图，能对图形进行各种形式的缩放操作。

本文中的缩放主要包括图形的放大、缩小和局部放大与全屏显示。

关键词:Visual Basic交互式CAD 缩放一、绪言 (4)二、开发基础 (5)(一) 交互式CAD简介 (5)(二) Visual Basic的简介 (5)三、系统分析 (6)(一) 可行性研究 (6)(二) 需求分析 (6)四、系统总体设计 (8)五、详细设计 (8)（一）界面制作 (8)（二）绘图 (9)（三）缩放 (11)六、用户手册 (16)七、结束语 (17)八、致谢 (18)九、参考文献 (19)图3-1系统的总体设计图3-2图像选项图3-3主界面图3-4窗口模板（二）绘图代码设计图3-5 “绘图”菜单图3-6 “缩放”菜单图3-7原始图形图3-8全局放大和全局缩小结果AB B F`C D C G ` D H `图3-9局部放大的原理图示图3-10用矩形窗口选择所要放大的局部范围图3-11 局部放大的效果(1)全屏显示全屏显示是要在绘图环境中刚好显示所有图元。

实际上，它是局部放大的一个特例。

就如图（3-12）所示，把矩形EFGH 中的图形元素正好全部显示在ABCD 矩形区域中。

所有图元的包围矩形可以通过比较所有图元各自的包围矩形得到。

所有图元包围矩形对角定点的最小横坐标和最小纵坐标可以确定一个点，最大横坐标和最大纵坐标可以确定另一个点，由两点所确定的矩形就是要求的包围矩图3-13原图图3-14 全屏显示的结果六、用户手册D B H ` F `运行系统，会出现一个界面就如下面所示的图---用户界面。

VB对AutoCAD的二次开

实验VB对AutoCAD的二次开发一、实验目的了解CAD二次开发的几种形式，掌握VB对AutoCAD进行二次开发，实现参数化绘图的技巧。

二、实验要求1、了解AutoCAD二次开发的基本原理2、掌握运用VB开发界面的方法3、掌握运用VB调用AutoCAD库函数，完成相关功能的方法三、实验步骤1、建立AutoCAD和VB之间的连接启动VB，建立“标准exe”程序，选择菜单“工程”——“引用”，选择“AutoCAD 2004 Type Library”。

2、创建界面3、程序编码1)定义全局变量Dim AcadApp As AcadApplication 'AutoCAD应用程序变量Dim AcadDoc As AcadDocument 'AutoCAD文档变量2)引用AutoCAD应用程序Private Sub Command1_Click()On Error Resume NextIf Err ThenErr.ClearEnd IfSet AcadApp = New AcadApplicationIf Err ThenMsgBox Err.DescriptionExit SubEnd If'设置AutoCAD应用程序参数AcadApp.WindowTop = 0AcadApp.WindowLeft = 400AcadApp.Width = 600AcadApp.Height = 800AcadApp.Visible = TrueAcadApp.Documents.AddSet AcadDoc = AcadApp.ActiveDocumentAcadDoc.WindowState = acMaxCommand4.Enabled = TrueEnd Sub3)参数化绘图Private Sub Command4_Click()'设置新图层Dim layer1 As AcadLayerDim layer2 As AcadLayerSet layer0 = yers.Item(0)Set layer1 = yers.Add("粗实线层")Set layer2 = yers.Add("中心线层")layer1.Lineweight = acLnWt080 '粗实线的线宽layer1.Color = acWhitelayer2.Color = acRedAcadDoc.Linetypes.Load "centerx2", "acad.lin"layer2.Linetype = "centerx2"'输入原始参数Dim Center(0 To 2) As DoubleDim Vert(0 To 7) As DoubleDim L04 As DoubleDim L01 As DoubleDim b As DoubleDim r As Doubleb = Val(Text2.Text): r = Val(Text1.Text) / 2: L01 = r - Val(Text3.Text) L04 = Sqr(r * r - (b / 2) ^ 2)Center(0) = 100: Center(1) = 100: Center(2) = 0'画中心线AcadDoc.ActiveLayer = layer2Dim line1 As AcadLineDim line2 As AcadLine'定义两直线的端点Dim pl1s(0 To 2) As DoubleDim pl1e(0 To 2) As DoubleDim pl2s(0 To 2) As DoubleDim pl2e(0 To 2) As Doublepl1s(0) = Center(0) - r - 1.5: pl1s(1) = Center(1): pl1s(2) = 0pl1e(0) = Center(0) + r + 1.5: pl1e(1) = Center(1): pl1e(2) = 0pl2s(0) = Center(0): pl2s(1) = Center(1) + r + 1.5: pl2s(2) = 0pl2e(0) = Center(0): pl2e(1) = Center(1) - r - 1.5: pl2e(2) = 0Set line1 = AcadDoc.ModelSpace.AddLine(pl1s, pl1e)Set line2 = AcadDoc.ModelSpace.AddLine(pl2s, pl2e)'创建辅助的优化多段线AcadDoc.ActiveLayer = layer1'定义键槽直线端点Dim p1(0 To 2) As DoubleDim p2(0 To 2) As DoubleDim p3(0 To 2) As DoubleDim p4(0 To 2) As DoubleDim angVal As DoubleDim pLine1 As AcadLineDim pLine2 As AcadLineDim pLine3 As AcadLineDim pArc As AcadArcDim pi As Double '定义圆周率p1(0) = Center(0) - b / 2: p1(1) = Center(1) + L01: p1(2) = 0p2(0) = p1(0): p2(1) = Center(1) + L04: p2(2) = 0p3(0) = p1(0) + b: p3(1) = p1(1): p3(2) = 0p4(0) = p1(0) + b: p4(1) = p2(1): p4(2) = 0Set pLine1 = AcadDoc.ModelSpace.AddLine(p1, p2)Set pLine2 = AcadDoc.ModelSpace.AddLine(p1, p3)Set pLine3 = AcadDoc.ModelSpace.AddLine(p3, p4)angVal = Atn((b / 2) / L04)pi = 3.1415Set pArc = AcadDoc.ModelSpace.AddArc(Center, r, pi / 2 + angVal, 2 * pi + pi / 2 - angVal)AcadApp.ZoomExtentsAcadDoc.ActiveLayer = layer0End Sub'查询Private Sub CmdSeek_Click() Dim aVal As Integer 'A值 aVal = CInt(Text1.Text) Text2.Text = GetVal(aVal)End Sub。

VB交互式CAD系统开发与实现-编程源代码-VB编程毕业设计

Option ExplicitGlobal Const PI = 3.1415926'绘图模式Public Enum GEDrawModeedmNormal = 1edmSelect = 2edmDelete = 3End Enum'线型Public Enum LineStylevbSolid = 0vbDash = 1vbDot = 2vbDashDot = 3vbDashDotDot = 4vbInvisible = 5vbInsideSolid = 6End Enum'命令类型Public Enum GECommandType ecUnknown = 0ecCreatePoint = 1ecCreateLine = 2ecCreatePolyLine = 3ecCreateCircle = 4ecCreateArc = 5ecCreateText = 6ecSelOnebyOne = 11ecSelLines = 12ecSelPolylines = 13ecSelCircles = 14ecSelArcs = 15ecSelTexts = 16ecSelAll = 17ecSelNone = 18ecMove = 21ecRotate = 22ecMirror = 23ecviewzoomin = 31ecViewZoomOut = 32ecViewLocalZoomOut = 33ecViewPan = 34ecViewExtent = 35End EnumPublic Type POINTAPIx As Longy As LongEnd TypePublic Type rectLeft As LongTop As LongRight As LongBottom As LongEnd TypePublic sLeft As DoublePublic sTopic As DoublePublic sRight As DoublePublic sBottom As DoublePublic Scal As DoublePublic ptLineBegin As New PositionPublic ptLineEnd As New PositionPublic ptPLPoints(1 To 100, 1 To 100) As New Position Public PLPoints(1 To 100, 1 To 100) As New Position Public intPLPointNum As IntegerPublic ptCircleCenter As New PositionPublic ptCircleR As New PositionPublic ptArcCenter As New PositionPublic ptArcBegin As New PositionPublic ptArcEnd As New PositionPublic Command As GECommandTypePublic GElements As New CGElementsPublic lines As New CLinesPublic polylines As New CPolylinesPublic circles As New CCirclesPublic arcs As New CArcsPublic texts As New CTextsPublic SelLines As New CLineSelPublic SelPLines As New CPLineSelPublic SelCircles As New CCircleSelPublic SelArcs As New CArcSelPublic SelTexts As New CTextsPublic intmStep As IntegerPublic PickRadius As DoublePublic bolMirror As BooleanPublic intArcMirrorNum As IntegerPublic ptBasePos As New PositionPublic ptDesPos As New PositionPublic pBasePos As New PositionPublic pDesPos As New PositionPublic scale1 As DoublePublic sinOriginX As DoublePublic sinOriginY As DoublePublic geNum As IntegerPublic entCount As IntegerPublic Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As LongPublic Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As rect) As LongPublic Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As LongFunction distPtoP(Pos1 As Position, Pos2 As Position) As DoubleDim disx As Double, disy As Double, dist As DoubleWith Pos1disx = .x - Pos2.xdisy = .y - Pos2.yEnd WithdistPtoP = Sqr(disx * disx + disy * disy)'distPtoP = (disx + disy + 2 * max(disx, disy)) / 3End Function'计算点到直线的距离Function distPtoL(pos As Position, CLine1 As CLine) As DoubleDim k As DoubleDim C As DoubleDim px As Double, py As DoubleDim distX As Double, distY As DoubleWith pospx = .xpy = .yEnd WithCall CLine1.LineKX(k, C)If k = 0 ThendistX = 10000distY = Abs(py - CLine1.pLineBegin.y)ElseIf k = 10000 ThendistX = Abs(px - CLine1.pLineBegin.x)distY = 10000ElsedistX = Abs(px - (py - C) / k)distY = Abs(py - (k * px + C))End IfdistPtoL = min(distX, distY)End FunctionFunction GetAngle(pBegin As Position, pEnd As Position) As Double Dim tansita As DoubleDim sita As DoubleDim subEBx As DoublesubEBx = Abs(pEnd.x - pBegin.x)If pEnd.x = pBegin.x Then subEBx = 0.0001tansita = (Abs(pEnd.y - pBegin.y)) / subEBxsita = Atn(tansita)'如果终点横坐标大于起点横坐标,并且终点纵坐标大于起点纵坐标If pEnd.x >= pBegin.x And pEnd.y >= pBegin.y ThenGetAngle = sita'如果终点横坐标小于起点横坐标,并且终点纵坐标大于起点纵坐标ElseIf pEnd.x <= pBegin.x And pEnd.y >= pBegin.y ThenGetAngle = PI - sita'如果终点横坐标小于起点横坐标,并且终点纵坐标小于起点纵坐标ElseIf pEnd.x <= pBegin.x And pEnd.y <= pBegin.y ThenGetAngle = PI + sita'如果终点横坐标大于起点横坐标,并且终点纵坐标小于起点纵坐标ElseIf pEnd.x >= pBegin.x And pEnd.y <= pBegin.y ThenGetAngle = 2 * PI - sitaEnd IfEnd FunctionFunction InBox(Box As Box, curpos As Position) As BooleanIf curpos.x > Box.minX And curpos.y > Box.minY _And curpos.x < Box.maxX And curpos.y < Box.maxY Then InBox = TrueElseInBox = FalseEnd IfEnd FunctionFunction min(la As Double, lb As Double) As DoubleIf la < lb Thenmin = laElsemin = lbEnd IfEnd FunctionFunction max(la As Double, lb As Double) As DoubleIf la > lb Thenmax = laElsemax = lbEnd IfEnd FunctionPublic Sub ReDraw(dmode As GEDrawMode)Dim pLine As New CLineDim pPLine As New CPolyLineDim pCircle As New CCircleDim pArc As New CArcDim pText As New CTextDim pGElement As CGElementDim i As Integer'按指定绘图模式重绘所有图元For Each pLine In linesSet pGElement = pLinepGElement.Draw (dmode)NextFor Each pPLine In polylinesSet pGElement = pPLinepGElement.Draw (dmode)NextFor Each pCircle In circlesSet pGElement = pCirclepGElement.Draw (dmode) NextFor Each pArc In arcsSet pGElement = pArcpGElement.Draw (dmode) NextFor Each pText In textsSet pGElement = pTextpGElement.Draw (dmode) NextEnd SubPublic Sub SelDraw()Dim pLine As New CLineDim pPLine As New CPolyLine Dim pCircle As New CCircle Dim pArc As New CArcDim pText As New CTextDim pGElement As CGElement Dim i As Integer'按指定绘图模式重绘所有图元For Each pLine In SelLinesSet pGElement = pLinepGElement.Draw (edmDelete)pGElement.Draw (edmSelect) NextFor Each pPLine In SelPLinesSet pGElement = pPLinepGElement.Draw (edmDelete)pGElement.Draw (edmSelect) NextFor Each pCircle In SelCirclesSet pGElement = pCirclepGElement.Draw (edmDelete)pGElement.Draw (edmSelect) NextFor Each pArc In SelArcsSet pGElement = pArcpGElement.Draw (edmDelete)pGElement.Draw (edmSelect)NextFor Each pText In SelTextsSet pGElement = pTextpGElement.Draw (edmDelete)pGElement.Draw (edmSelect)NextEnd SubPublic Function SelEntityNum() As IntegerSelEntityNum = SelLines.Count + SelPLines.Count + SelCircles.Count + SelArcs.Count End Function'删除所有选择集中的图元Public Sub SelRemove()Dim i As IntegerDim intLCount As IntegerDim intPLCount As IntegerDim intCCount As IntegerDim intACount As IntegerintLCount = SelLines.CountintPLCount = SelPLines.CountintCCount = SelCircles.CountintACount = SelArcs.CountWith SelLinesFor i = intLCount To 1 Step -1.Remove (i)Next iEnd WithWith SelPLinesFor i = intPLCount To 1 Step -1.Remove (i)Next iEnd WithWith SelCirclesFor i = intCCount To 1 Step -1.Remove (i)Next iEnd WithWith SelArcsFor i = intACount To 1 Step -1.Remove (i)End WithEnd Sub'彻底删除所有选择集中的图元Public Sub AllSelRemove()Dim i As IntegerDim intLCount As IntegerDim intPLCount As IntegerDim intCCount As IntegerDim intACount As IntegerDim intTCount As IntegerintLCount = SelLines.CountintPLCount = SelPLines.CountintCCount = SelCircles.CountintACount = SelArcs.CountintTCount = SelTexts.Count'删除直线图元选择集中的所有图元'并从直线段集合类中删除对应图元With SelLinesFor i = intLCount To 1 Step -1lines.Remove (Str(.Item(i).ID_Line)).Remove (i)Next iEnd With'删除多义线图元选择集中的所有图元'并从多义线集合类中删除对应图元With SelPLinesFor i = intPLCount To 1 Step -1polylines.Remove (Str(.Item(i).ID_PLine)).Remove (i)Next iEnd With'删除圆类图元选择集中的所有图元'并从圆集合类中删除对应图元With SelCirclesFor i = intCCount To 1 Step -1circles.Remove (Str(.Item(i).ID_Circle)).Remove (i)Next i'删除圆弧图元选择集中的所有图元'并从圆弧集合类中删除对应图元With SelArcsFor i = intACount To 1 Step -1arcs.Remove (Str(.Item(i).ID_Arc)).Remove (i)Next iEnd With'删除文本图元选择集中的所有图元'并从文本集合类中删除对应的图元With SelTextsFor i = intTCount To 1 Step -1texts.Remove (Str(.Item(i).ID_Text)).Remove (i)Next iEnd WithEnd Sub'根据不同的选择方式选择图元Public Sub SelectGEs(SelType As GECommandType) Dim pGElement As New CGElementDim pLine As New CLineDim pPLine As New CPolyLineDim pCircle As New CCircleDim pArc As New CArcDim pText As New CTextDim PLPoints(1 To 100, 1 To 100) As PositionDim i As IntegerDrawMain.picDraw.DrawMode = 13Select Case SelTypeCase ecSelLinesReDraw (edmNormal)SelRemoveIf lines.Count > 0 ThenFor Each pLine In linesSet pGElement = pLineWith pGElement.Draw (edmDelete).Draw (edmSelect) '用选择模式绘图元End With'将图元添加到选择集SelLines中With pLineCallSelLines.Add(.geLineWidth, .geLineStyle, .geColor, .ID_Line, .pLineBegin, .pLineEnd) End WithNextEnd IfCase ecSelPolylinesReDraw (edmNormal)SelRemoveIf polylines.Count > 0 ThenFor Each pPLine In polylinesWith pPLineFor i = 1 To .intPLinePointNumSet PLPoints(.ID_PLine, i) = .pPLPoints(.ID_PLine, i)Next iEnd WithSet pGElement = pPLineWith pGElement.Draw (edmDelete).Draw (edmSelect)End WithWith pPLineCall SelPLines.Add(.intPLinePointNum, PLPoints(), .geLineWidth, .geLineStyle, .geColor, .ID_PLine)End WithNextEnd IfCase ecSelCirclesReDraw (edmNormal)SelRemoveIf circles.Count > 0 ThenFor Each pCircle In circlesSet pGElement = pCircleWith pGElement.Draw (edmDelete).Draw (edmSelect)End WithWith pCircleCallSelCircles.Add(.geLineWidth, .geLineStyle, .geColor, .pCircleR, .pCenter, .ID_Circle)NextEnd IfCase ecSelArcsReDraw (edmNormal)SelRemoveIf arcs.Count > 0 ThenFor Each pArc In arcsSet pGElement = pArcWith pGElement.Draw (edmDelete).Draw (edmSelect)End WithWith pArcCallSelArcs.Add(.geLineWidth, .geLineStyle, .geColor, .pCenter, .pBegin, .pEnd, .ID_Arc) End WithNextEnd IfCase ecSelTextsReDraw (edmNormal)SelRemoveIf texts.Count > 0 ThenFor Each pText In textsSet pGElement = pTextWith pGElement.Draw (edmSelect)End WithWith pTextCall SelTexts.Add(.x, .y, .Height, .Wide, .Content, .geColor, .ID_Text)End WithNextEnd IfCase ecSelAllReDraw (edmNormal)If GElements.Count > 0 ThenFor Each pLine In linesSet pGElement = pLineWith pGElement.Draw (edmDelete).Draw (edmSelect) '用选择模式绘图元'将图元添加到选择集SelLines中With pLineCallSelLines.Add(.geLineWidth, .geLineStyle, .geColor, .ID_Line, .pLineBegin, .pLineEnd) End WithNextEnd IfIf polylines.Count > 0 ThenFor Each pPLine In polylinesWith pPLineFor i = 1 To .intPLinePointNumSet PLPoints(.ID_PLine, i) = .pPLPoints(.ID_PLine, i)Next iEnd WithSet pGElement = pPLineWith pGElement.Draw (edmDelete).Draw (edmSelect)End WithWith pPLineCall SelPLines.Add(.intPLinePointNum, PLPoints(), .geLineWidth, .geLineStyle, .geColor, .ID_PLine)End WithNextEnd IfIf circles.Count > 0 ThenFor Each pCircle In circlesSet pGElement = pCircleWith pGElement.Draw (edmDelete).Draw (edmSelect)End WithWith pCircleCallSelCircles.Add(.geLineWidth, .geLineStyle, .geColor, .pCircleR, .pCenter, .ID_Circle) End WithNextEnd IfIf arcs.Count > 0 ThenFor Each pArc In arcsSet pGElement = pArcWith pGElement.Draw (edmDelete).Draw (edmSelect)End WithWith pArcCallSelArcs.Add(.geLineWidth, .geLineStyle, .geColor, .pCenter, .pBegin, .pEnd, .ID_Arc) End WithNextEnd IfIf texts.Count > 0 ThenFor Each pText In textsSet pGElement = pTextWith pGElement.Draw (edmSelect)End WithWith pTextCall SelTexts.Add(.x, .y, .Height, .Wide, .Content, .geColor, .ID_Text)End WithNextEnd IfCase ecSelNoneReDraw (edmNormal)Call SelRemoveEnd SelectEnd SubPublic Sub Coordinate()DrawMain.picDraw.Scale (sLeft, sTopic)-(sRight, sBottom)DrawMain.picDraw.RefreshEnd SubOption ExplicitPrivate Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPrivate Const SWP_NOSIZE = &H1Private Const SWP_NOMOVE = &H2Private Const HWND_TOPMOST = -1Private Const HWND_NOTOPMOST = -2Dim X01 As Double, Y01 As Double, X02 As Double, Y02 As Double, BX As Double, BY As DoublePrivate bolHandleShow As BooleanPrivate bolEntitySizing As BooleanPrivate Sub About_Click()frmAbout.ShowEnd SubPrivate Sub Arc_Click()Command = ecCreateArcEnd SubPrivate Sub Circle_Click()Command = ecCreateCircleEnd SubPrivate Sub Delete_Click()'删除被选中的所有图元AllSelRemove'更新图片框中的内容DrawMain.picDraw.RefreshEnd SubPrivate Sub Extent_Click()Dim minX As DoubleDim minY As DoubleDim maxX As DoubleDim maxY As DoubleDim rc As rectDim rcLB As New PositionDim rcRT As New PositionDim scalex As Double, scaley As DoubleCall GetClientRect(DrawMain.picDraw.hwnd, rc)With rcLB.x = rc.Left * Screen.TwipsPerPixelX.y = rc.Bottom * Screen.TwipsPerPixelYEnd WithWith rcRT.x = rc.Right * Screen.TwipsPerPixelX.y = rc.Top * Screen.TwipsPerPixelYEnd WithCall GetExtentBox(minX, minY, maxX, maxY)'计算新坐标系与逻辑坐标的比例因子scalex = Abs((rcRT.x - rcLB.x) / (maxX - minX))scaley = Abs((rcRT.y - rcLB.y) / (maxY - minY))scale1 = min(scalex, scaley)'重新设置视口大小sLeft = minXsTopic = maxYIf scalex < scaley ThenminY = maxY - (maxX - minX) * ScalElsemaxX = minX + (maxY - minY) / ScalEnd IfsRight = maxXsBottom = minYCall CoordinateEnd SubPrivate Sub Form_Load()'显示启动窗口frmFlash.ShowSetWindowPos frmFlash.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZEDrawMain.picDraw.DrawMode = 6PickRadius = 0.05Command = 0intArcMirrorNum = 0bolMirror = Falsescale1 = 1With picDrawScal = .ScaleHeight / .ScaleWidth.ScaleWidth = 640 * 15.ScaleHeight = .ScaleWidth * ScalEnd WithsLeft = -320XX 15sTopic = picDraw.ScaleHeight / 2sRight = -320XX 15 + picDraw.ScaleWidth sBottom = -picDraw.ScaleHeight / 2Call CoordinateEnd SubPrivate Sub picDraw_Paint()ReDraw (edmNormal)SelDrawEnd SubPrivate Sub Form_Resize()picDraw.RefreshEnd SubPrivate Sub Line_Click()Command = ecCreateLineEnd SubPrivate Sub localEnlarge_Click() Command = ecViewZoomOutEnd SubPrivate Sub localZoomOut_Click() Command = ecViewLocalZoomOutEnd SubPrivate Sub Mirror_Click()Command = ecMirrorEnd SubPrivate Sub Move_Click()Command = ecMoveEnd SubPrivate Sub SelNone_Click()SelectGEs (ecSelNone)End SubPrivate Sub picDraw_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Dim pPos As New PositionDim lpPoint As New PositionDim pCommand As CCommandDim pCreateLine As New CCreateLineDim pCreatePolyline As New CCreatePolyLineDim pCreateCircle As New CCreateCirceDim pCreateArc As New CCreateArcDim pCreateText As New CCreateTextDim pSelect As New CSelectDim pMove As New CMoveDim pRotate As New CRotateDim pMirror As New CMirrorDim pViewLocalZoomOut As New CViewLocalZoomOutDim pViewPan As New CviewPanOn Error Resume NextWith pPos.x = x.y = yEnd WithIf Button = vbLeftButton ThenSelect Case CommandCase ecCreateLineSet pCommand = pCreateLineCase ecCreatePolyLineSet pCommand = pCreatePolylineCase ecCreateCircleSet pCommand = pCreateCircleCase ecCreateArcSet pCommand = pCreateArcCase ecCreateTextSet pCommand = pCreateTextCase ecSelOnebyOneSet pCommand = pSelectCase ecMoveSet pCommand = pMoveCase ecRotateSet pCommand = pRotateCase ecMirrorSet pCommand = pMirrorCase ecViewLocalZoomOutSet pCommand = pViewLocalZoomOutCase ecViewPanSet pCommand = pViewPanEnd SelectCall pCommand.LButtonDown(pPos)ElseIf Button = vbRightButton ThenSelect Case CommandCase ecCreateLineSet pCommand = pCreateLineCase ecCreatePolyLineSet pCommand = pCreatePolylineCase ecCreateCircleSet pCommand = pCreateCircleCase ecCreateArcSet pCommand = pCreateArcCase ecCreateTextSet pCommand = pCreateTextCase ecMoveSet pCommand = pMoveCase ecRotateSet pCommand = pRotateCase ecMirrorSet pCommand = pMirrorCase ecViewLocalZoomOutSet pCommand = pViewLocalZoomOutCase ecViewPanSet pCommand = pViewPanEnd SelectCall pCommand.RButtonDown(pPos)End IfEnd SubPrivate Sub picDraw_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Dim pPos As New PositionDim lpPoint As New PositionDim pCreateLine As New CCreateLineDim pCreatePolyline As New CCreatePolyLineDim pCreateCircle As New CCreateCirceDim pCreateArc As New CCreateArcDim pCreateText As New CCreateTextDim pSelect As New CSelectDim pMove As New CMoveDim pRotate As New CRotateDim pMirror As New CMirrorDim pCommand As New CCommandDim pViewLocalZoomOut As New CViewLocalZoomOut Dim pViewPan As New CviewPanStatusBar1.Panels(1).Text = "X=" & Str(x) & " Y=" & Str(y)With pPos.x = x.y = yEnd WithSelect Case CommandCase ecCreateLineSet pCommand = pCreateLineCase ecCreatePolyLineSet pCommand = pCreatePolylineCase ecCreateCircleSet pCommand = pCreateCircleCase ecCreateArcSet pCommand = pCreateArcCase ecCreateTextSet pCommand = pCreateTextCase ecMoveSet pCommand = pMoveCase ecRotateSet pCommand = pRotateCase ecMirrorSet pCommand = pMirrorCase ecViewLocalZoomOutSet pCommand = pViewLocalZoomOutCase ecViewPanSet pCommand = pViewPanEnd SelectCall pCommand.MouseMove(pPos)End SubPrivate Sub SelAll_Click()SelectGEs (ecSelAll)End SubPrivate Sub SelArc_Click()SelectGEs (ecSelArcs)End SubPrivate Sub SelCircle_Click() SelectGEs (ecSelCircles)End SubPrivate Sub SelLine_Click() SelectGEs (ecSelLines)End SubPrivate Sub SelOnebyOne_Click() Command = ecSelOnebyOne End SubPrivate Sub SelPolyline_Click() SelectGEs (ecSelPolylines)End SubPrivate Sub SelText_Click() SelectGEs (ecSelTexts)End SubPrivate Sub PolyLine_Click() Command = ecCreatePolyLine End SubPrivate Sub Rotate_Click() Command = ecRotateEnd SubPrivate Sub ScaleZoomIn_Click() Call ScaleZoom(0.8, 0.8)End SubPrivate Sub ScaleZoomOut_Click() Call ScaleZoom(1.2, 1.2)End SubPrivate Sub SnapTo_Click() SnapToGrid = TrueEnd SubPrivate Sub Text_Click() Command = ecCreateTextEnd SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.KeyCase "Select"SelOnebyOne_ClickCase "Line"Line_ClickCase "Polyline"PolyLine_ClickCase "Circle"Circle_ClickCase "Arc"Arc_ClickCase "Text"Text_ClickCase "Move"Move_ClickCase "Rotate"Rotate_ClickCase "Mirror"Mirror_ClickCase "ZoomO"ScaleZoomOut_ClickCase "ZoomI"ScaleZoomIn_ClickCase "ZoomOut"ZoomOut_ClickCase "ZoomIn"ZoomIn_ClickCase "ZoomLocal"localZoomOut_ClickCase "Extent"Extent_ClickCase "GMove"ViewPan_ClickEnd SelectEnd SubPrivate Sub ViewPan_Click()Command = ecViewPanEnd SubPrivate Sub ZoomIn_Click()sLeft = sLeft * 1.2sRight = sRight * 1.2sTopic = sTopic * 1.2sBottom = sBottom * 1.2Call CoordinateEnd SubPrivate Sub ScaleZoom(scalex As Double, scaley As Double)Dim i As IntegerDim pLine As New CLineDim pPLine As New CPolyLineDim pCircle As New CCircleDim pArc As New CArcDim pGElement As New CGElementDrawMain.picDraw.DrawMode = 13If SelEntityNum() > 0 ThenFor Each pLine In SelLinesSet pGElement = pLineWith pGElement.Draw (edmDelete) '清除原来位置上的图元Call .ScaleTransform(scalex, scaley).Draw (edmSelect)End WithWith pLinelines.Remove (Str(.ID_Line))Calllines.Add(.geLineWidth, .geLineStyle, .geColor, .ID_Line, .pLineBegin, .pLineEnd, Str(.ID_Line))End WithNextFor Each pPLine In SelPLinesSet pGElement = pPLineWith pGElement.Draw (edmDelete)Call .ScaleTransform(scalex, scaley).Draw (edmSelect)End WithWith pPLineDim PLPoints(1 To 100, 1 To 100) As PositionFor i = 1 To .intPLinePointNumSet PLPoints(.ID_PLine, i) = .pPLPoints(.ID_PLine, i)Next ipolylines.Remove (Str(.ID_PLine))Call polylines.Add(.intPLinePointNum, PLPoints, .geLineWidth, .geLineStyle, .geColor, .ID_PLine, Str(.ID_PLine))End WithNextFor Each pCircle In SelCirclesSet pGElement = pCircleWith pGElement.Draw (edmDelete)Call .ScaleTransform(scalex, scaley).Draw (edmSelect)End WithWith pCirclecircles.Remove (Str(.ID_Circle))Callcircles.Add(.geLineWidth, .geLineStyle, .geColor, .pCircleR, .pCenter, .ID_Circle, Str(.ID_Circle))End WithNextFor Each pArc In SelArcsSet pGElement = pArcWith pGElement.Draw (edmDelete)Call .ScaleTransform(scalex, scaley).Draw (edmSelect)End WithWith pArcarcs.Remove (Str(.ID_Arc))Callarcs.Add(.geLineWidth, .geLineStyle, .geColor, .pCenter, .pBegin, .pEnd, .ID_Arc, Str(.ID_Arc)) End WithNextEnd IfDrawMain.picDraw.DrawMode = 6End SubPrivate Sub ZoomOut_Click()sLeft = sLeft * 0.8sRight = sRight * 0.8sTopic = sTopic * 0.8sBottom = sBottom * 0.8Call CoordinateEnd SubPrivate Sub GetExtentBox(minX As Double, minY As Double, maxX As Double, maxY As Double)Dim pLine As New CLineDim pPLine As New CPolyLineDim pCircle As New CCircleDim pArc As New CArcDim pText As New CTextDim pGElement As CGElementDim sourceBox As New BoxDim i As Integer'给矩形对角顶点的坐标赋初值minX = 0minY = 0maxX = 0maxY = 0'按指定绘图模式重绘所有图元For Each pLine In linesWith pLineSet ptLineBegin = .pLineBeginSet ptLineEnd = .pLineEndEnd WithSet pGElement = pLineCall pGElement.GetBox(sourceBox)With sourceBoxminX = min(minX, .minX)minY = min(minY, .minY)maxX = max(maxX, .maxX)maxY = max(maxY, .maxY)End WithNextFor Each pPLine In polylinesWith pPLineintPLPointNum = .intPLinePointNumFor i = 1 To intPLPointNumSet ptPLPoints(.ID_PLine, i) = .pPLPoints(.ID_PLine, i)Next iEnd WithSet pGElement = pPLineCall pGElement.GetBox(sourceBox)With sourceBoxminX = min(minX, .minX)maxX = max(maxX, .maxX)maxY = max(maxY, .maxY)End WithNextFor Each pCircle In circlesWith pCircleSet ptCircleCenter = .pCenterSet ptCircleR = .pCircleREnd WithSet pGElement = pCircleCall pGElement.GetBox(sourceBox) With sourceBoxminX = min(minX, .minX)minY = min(minY, .minY)maxX = max(maxX, .maxX)maxY = max(maxY, .maxY)End WithNextFor Each pArc In arcsWith pArcSet ptArcCenter = .pCenterSet ptArcBegin = .pBeginSet ptArcEnd = .pEndEnd WithSet pGElement = pArcCall pGElement.GetBox(sourceBox) With sourceBoxminX = min(minX, .minX)minY = min(minY, .minY)maxX = max(maxX, .maxX)maxY = max(maxY, .maxY)End WithNextFor Each pText In textsSet pGElement = pTextCall pGElement.GetBox(sourceBox) With sourceBoxminX = min(minX, .minX)minY = min(minY, .minY)maxX = max(maxX, .maxX)End With NextEnd Sub。

VB开发CAD(圆锥滚子轴承设计说明书)

毕业设计(论文)圆锥滚子轴承辅助设计系名：机械工程系专业班级：****学生姓名：***学号：**指导教师姓名：***指导教师职称：讲师2010 年4月目录第一章设计概要1.1 系统运行平台 (6)1.1.1 CAD的概念 (6)1.1.2 VB的概念 (6)1.1.3 系统要求及模型建立 (6)1.2 IDEF0框图 (7)第二章圆锥滚子轴承设计原理 (9)2.1基本概念及术语 (9)2.2 滚动轴承类型的选择 (9)2.3 按额定动载选择轴承 (9)2.4基本额定动载荷计算 (10)第三章圆锥滚子轴承的程序设计 (12)3.1圆锥滚子轴承具体实现的方法 (12)3.2 连接数据库Access (12)3.3 根据轴承最小内径选择参数 (12)3.4 校核接触疲劳强度 (13)3.5 CAD出图 (14)第四章软件使用说明 (15)4.1 系统运行环境 (15)4.2 VB操作 (15)总结 (16)致谢 (17)参考文献 (17)圆锥滚子轴承计算机辅助设计专业班级：计算机辅助设计与制造学生姓名：***指导教师：*** 职称：讲师摘要本设计是设计一个基于圆锥滚子轴承设计的参数化系统。

其设计对象为圆锥滚子轴承。

所设计系统的功能分为对其进行参数化强度计算和参数化后自动出图两个部分。

在本设计中，圆锥滚子轴承的几何尺寸确定方法和强度计算方法主要参照《机械设计基础》,所用到的软件有Microsoft Visual Basic 6.0, Office Access2003、AutoCAD2004。

此系统在Windows XP系统中进行设计和调试并可正常运行。

关键词：圆锥滚子轴承设计参数化自动生成图形Straight bevel gear computer-aided designAbstract The design is based on the design of a straight bevel gear design parameters of the system. The design targets for the straight bevel gear. Designed by the function of the system into its parameters and parameters of strength calculation of automatically after drawing two parts. In this design, straight bevel gear geometry determine the method of calculation methods and intensity of the main reference "mechanical design basis", the software used by Microsoft Visual Basic 6.0, Office Access2003, AutoCAD2005. The system in Windows XP system design and debug and normal operation.Key words:straight bevel gear design parameters of the automatically generated graphics引言目前,国际市场轴承年销售额为300亿美元,其中我国为30亿美元,占1/10。

用VB对AutoCAD进行二次开发

用VB对AutoCAD进行二次开发|用VB对AutoCAD进行二次开发AutoCAD一直是CAD市场中的主流产品。

随着AutoCAD的日益普及，在其上进行二次开发的工具也不断更新。

从早期的AutoLisp、ADS、DCL到现在流行的ObjectARX、ActiveXAutomation、VisualLisp，均可十分方便地对AutoCAD进行二次开发。

本文主要讨论关于运用VisualBasic对AutoCAD基于ActiveXAutomation的二次开发技术。

选用ActiveX有两个原因，一是因为VisualBasic的普及性与易用性，二是采用这种方法进行二次开发可方便地实现与其它图形软件的接口，如与SolidWorks实现实体造型与二维绘图的结合，以及根据用户的特殊需要开发出一定功能的软件。

的自动(如VB的图在启动对象。

EndIf2.Preferences与Document对象与AutoCAD中的Preferences对话框的作用相同，通过Preferences对象可以读取或设置AutoCAD的一些基本设置。

Preferences对象通过Application的Preferences属性返回。

DimAcadPrefasObjectSetAcadPref=AcadApp.Preferences比如，用户可通过Preferences对象进行如下的设置AcadPref.Cursorsize=100AcadPref.DisplayScreenMenu=acTrueAcadPref.DisplayScrollBars=Check1.valueDocument对象表示AutoCAD中中当前打开的文档，对AutoCAD中的任何其它操作都需用到Document对象，该对象可以通过ActiveDocument属性返回。

DimAcadDocasObjectSetAcadDoc=AcadApp.ActiveDocumentAutoDesk公司使用了集合的概念。

基于VB的AutoCAD二次开发

基于VB的AutoCAD二次开发摘要：Visual Basic是当今世界上最流行的编程语言之一，CAD是目前使用最广泛的绘图软件，本文将在测绘领域，探讨基于Visual Basic对AutoCAD进行二次开发，对外业获取的数据内业进行自动绘图，提高工作效率。

关键词：Visual basic；AutoCAD；ActiveX；CAD二次开发1.引言在使用全站仪的外业测图，如果我们对采集的数据赋予遵循特定规则的简码，用成图软件导入外业数据，然后利用二次开发的软件完成自动绘图，更能提高作业效率。

本文将基于Visual Basic对AutoCAD二次开发一个自动绘图的程序。

2.需求分析需求分析：该程序可以实现“外业测图，内业自动绘图”的功能。

具体是通过导出外业数据，对数据进行读取、分析识别，然后实现在AutoCAD画布上展点，自动绘图。

3.程序的设计程序的设计包括界面和功能设计和数据格式的设计。

3.1界面和功能设计程序Frmbase窗体由一个菜单栏、一个状态栏、一个公共对话框组成。

该程序主窗体frmbase设计如图3.1所示。

图3.1 frmbase窗体设计效果图菜单栏“文件”菜单下有创建新图形文件、打开、保存图形文件、导入DXF文件、导出DXF和BMP文件、关闭图形文件和退出程序这些子菜单。

如图3.2所示。

图3.2 “文件”菜单及其子菜单菜单栏“绘图”菜单下有展点和自动绘图子菜单，而展点可以通过两种数据文件来读取数据，所以展点子菜单下还有两个子菜单。

如图3.3所示。

图3.3 “绘图”菜单及其子菜单3.2数据格式的设计数据格式的设计：文件后缀为*.dat或者*.xls。

第一列是点名，第二列是简码，第三列是AutoCAD中的Y坐标，也是测量坐标系中的X坐标，第四列是测量坐标系中的Y坐标，第五列是高程。

编码规则：以地物名字的中文拼音首字母进行命名，例如井盖的简码为“JG”，平房的简码为“pf”。

图上的地物都是由点状地物、线状地物和面状地物这三种的抽象。

基于 VB 的交互式 CAD 系统开发与实现

基于 VB 的交互式 CAD 系统开发与实现
王小琼
【期刊名称】《计算机光盘软件与应用》
【年(卷),期】2012(000)012
【摘要】通过交互式 CAD 系统不仅可以实现鼠标绘图，还能够选择图元，并且对图元进行基本操作，其中 VB 是 CAD 开发工具使用最简单，应用最为广泛的开发工具。

本文将根据 VB 的基本操作，探索基于 VB 的交互式 CAD 系统的开发和实现。

【总页数】2页(P196-196,198)
【作者】王小琼
【作者单位】梅州市技师学院,广东梅州 514021
【正文语种】中文
【中图分类】TP391.72
【相关文献】
1.基于AutoCAD-VBA的对象交互式操作方法探讨 [J], 郑宾
2.基于AutoCAD-VBA的交互式操作方法探讨 [J], 郑宾
3.基于AutoCAD VBA的无缝线路一体化设计系统开发 [J], 敖翔
4.基于AutoCAD VBA的齿轮滚刀CAD系统开发 [J], 张春雨;俞宗嘉;孙旭
5.VB环境下交互式拉刀CAD系统的实现 [J], 尹洋
因版权原因，仅展示原文概要，查看原文内容请购买。

AutoCAD VBA工程及VBA交互开发环境教程

目录第一章VBA入门 (1)1.1了解嵌入和全局VBA工程 (1)1.2用VBA管理器组织工程 (1)1.3处理宏 (3)1.4用VBA IDE编辑工程 (4)1.5更多的信息 (9)1.6回顾AutoCAD VBA 工程术语 (9)1.7回顾AutoCAD VBA 命令 (10)第二章理解ActiveX自动操作基础 (10)2.2访问对象层次 (14)2.3通过集合对象操作 (15)2.4理解属性和方法 (17)2.5理解父对象 (17)2.6定位类型库 (17)2.7在数据库中返回第一个图元 (17)2.8在方法和属性中使用变体 (18)2.9使用其它程序语言 (19)第三章控制AutoCAD环境 (22)3.2设定AutoCAD参数 (24)3.3控制应用程序窗口 (24)3.4控制图形窗口 (25)3.5重置活动对象 (32)3.6设定和返回系统变量 (33)3.7精确制图 (33)3.8提示用户输入 (38)3.9访问AutoCAD命令行 (41)3.10工作于无打开文档状态 (41)3.11输入其它文件格式 (41)3.12输出到其它文件格式 (42)第四章创建和编辑AutoCAD图元 (43)4.1创建对象 (43)4.2编辑对象 (50)4.3使用图层、颜色和线型 (71)4.4添加文本到图形中 (81)第五章标注与公差 (95)5.1标注的概念 (95)5.2创建标注 (97)5.3编辑标注 (101)5.4利用标注样式 (102)5.5在模型空间和图纸空间中标注 (105)5.6创建引线及注解 (105)5.7创建形位公差 (107)第六章定义菜单和工具栏 (108)6.1理解MenuBar和MenuGroups集合 (109)6.2加载菜单组 (110)6.3改变菜单条 (111)6.4创建和编辑下拉菜单和快捷菜单 (113)6.5建立并编辑工具栏 (119)6.6建立宏 (125)6.7对菜单项和工具栏项增加状态栏帮助 (128)6.8在右键菜单中增加条目 (129)第七章使用事件 (130)7.1了解AutoCAD中的事件 (130)7.2编写事件处理器的方法 (131)7.3处理应用程序级事件 (132)7.4处理文档级事件 (134)7.5处理对象级事件 (136)第八章在三维空间下工作 (138)8.1指定三维坐标 (138)8.2定义用户坐标系统 (140)8.3坐标转换 (141)8.4建立三维对象 (143)8.5在三维中编辑 (147)8.6编辑三维实体 (150)第九章定义布局及打印 (153)9.1了解模型空间和图纸空间 (153)9.2了解布局 (153)9.3了解视口 (155)9.4打印图纸 (161)第十章-高级绘图与组织技术 (163)10.1使用光栅图像 (163)10.2使用块和属性 (167)第一章VBA入门本章将为你介绍AutoCAD VBA工程及VBA交互开发环境(VBA IDE)。

AUTO cad二次开发论文(键 VB开发)

摘要本说明书主要是关于AutoCAD 2000的用VB语言二次开发的说明和利用VB 语言开发船舶标准件的源程序。

说明书中主要涉及到了，AutoCAD软件的使用、VB语言简介、船舶标准件的结构特点和技术要求和利用VB编制的船舶标准件程序。

论文中介绍了设计人员的设计思路。

船舶标准零件主要包括：螺栓、螺母、垫圈、键、销、滚动轴、承弹簧等。

船舶标准件的结构特点、图形画法及技术要求是本次设计的基础，熟练掌握并用AutoCAD VBA（Visual Basic for Application）语言对AutoCAD进行船舶标准零件二次开发，以达到下述目的：调用程序时出现对话框，输入要求的零件主要参数后能够自动生成零件图形。

并且图形要符合国家标准件的技术要求。

AutoCAD VBA（Visual Basic for Application）语言的任务是对AutoCAD 进行二次开发促使AutoCAD更高效的工作。

关键词：标准零件、AutoCAD VBA语言、AutoCAD的二次开发- Ⅰ-ABSTRACTManual this about 2000 AutoCAD with VB explanation and utilize VB language develop source program , shipping of standard component, language of secondary development mainly. Have involved mainly in the manual , use, VB, AutoCAD of software language brief introduction of, structure characteristic and specification requirement , shipping of standard component utilize shipping standard component procedure that VB work out. Have introduced the designer's mentality of designing in the thesis.Whether shipping standard part include mainly. Bolt , nut , washer , key , axis , bearing the spring of selling , rolling ,etc.. Structure characteristic , the technique of painting of the figure and specification requirement for the shipping standard component are foundations designed this time, know and language carry on shipping standard part secondary development to AutoCAD with AutoCAD VBA (Visual Basic for Application ) skillfully, in order to achieve the following purposes:Appear communication frame at the procedure of transfering, part required to input can produce the part figure automatically behind the main parameter. And the figure should accord with the specification requirement for the national standard component .AutoCAD VBA (Visual Basic for Application) task of language to carry on secondary development impel AutoCAD high-efficient work to AutoCADKEY WORDS: standard part、AutoCAD VBA language、Secondary development of AutoCAD- Ⅱ -前言计算机辅助制图是现代企业生产和设计的重要工具，AutoCAD是计算机辅助设计工具的一种，VB 是AutoCAD软件的重要组成部分。

基于VB的交互式CAD系统开发与实现

摘要：通过交互式ＣＤ系统不仅可以实现鼠标绘图，还能够选择图元，并且对图元进行基本操作，其中ＶＡＢ是ＣＤ开发工具Ａ使用最简单，应用最为广泛的开发工具。本文将根据Ｖ的基本操作，探索基于ＶＢＢ的交互式ＣＤＡ系统的开发和实现。
计算机光盘软件与应用
软件设计开发ＣｍｕｅＤＳｆｗｒｎｐｌｃｔｏｓｏｐｔｒＣｏｔａｅａｄＡｐａｉｎｉ２１年第１０２２期
基于ＶＢ的交互式ＣＤ系统开发与实现Ａ
王小琼
（州市技师学院，广东梅州５４２）梅１０１
关键词：ＶＢ；交互式ＣＤＡ系统；开发
中图分类号：Ｔ３１２文献标识码：ＡＰ９．７文章编号：１０－５９２１）２０９－２０７９９（０２１－１６０
ＶＢ是ＶｓａＢｓｉｌａｉ言的缩写，Ｂ的强大功能是毋庸置疑ｕｃ语Ｖ的，它是交互式ＣＤ开发工具的中的重要工具，它介绍了交互Ａ式ＣＤＡ系统开发技术，剖析了构造系统的思路和技巧。笔者将在下文中就Ｖ语言做出更加详细的阐述，讨其在交互式ＣＤＢ探Ａ中的开发与实现。
一
、
基本概念－
（）交互式ＣＡ概述一ＤＣＤ是．ｏｕｅｉｅｅｉｎ的缩写，是指利用计算机及ＡＣｍｐｔＡｄｄＤｓｒｇ其图形设备帮助用户进行设计工作，ＣＡＤ的计算机设计工作往往需要大量的计算和分析，在不断的对比中确定最优的设计方案。所有设计信息，包括图形、数据等都能存放在计算机的内存里，并且能够快速检索。ＣＤＡ最早是应用在汽车制造、飞机制造等产业中，随着计算机的普及，其应用范围也逐渐扩大。ＡＣＤ的实现技术也经历了很大的发展时期，在长期的发展中逐渐成熟。计算机技术的进一步提高也为ＣＤＡ的发展创造了条件。随着电脑性能的提高，基于ＣＤ的立体绘图得到了更广泛的应用，Ａ使得绘图设计的效果更加突出，从而提高了设计质量。交互式ＣＤＡ技术是由Ｃ发展而来的，交互式ＣＤＡＤＡ是一个可以实现鼠标绘图，选择图元，并且能对图元进行放大、缩小、操作等的技术。简单来说即是指如果通过鼠标在屏幕上画一条直线，选中它时在直线的两端显示方形手柄，移动手柄可以改变直线段的方位、长短等。交互式ＣＤ技术广泛应用于各种专业图形处理软Ａ件，如ＡｔＣ、Ｐｗｒｏｎ等。就交互式ＣｕｏＡＤｏｃｉｔＰＤＡ而言，它的任务包括了定位、定向以及定量、移动等。交互式设计在实际过程中必须遵循以下原则：１尽可能提供缺省值；、、２强化容错功能：３、数据输入方便；４、有完善的帮助系统；５、操作过程具有历史记忆性，包括恢复和撤销操作；、图过程要具有可见性；７６绘、各项指令的反馈速度快。（）Ｖ二Ｂ简介ｖ — ｖｓｌａｉ一种具有强大功能的编程语言，ＶＢＢｊｓａｕＢｃ是具有较长的发展史，不断发展完善的过程中国得到了最为广泛在的应用。Ｖ的发展经历了从Ｂｓ发展到ＶｓａＢｉ的过程，ＢａｉｃｉｕｌａｃｓＢｉ直以其简单易学而闻名于世，从一开始就受到了多数学ｓａｃ一者的喜爱。然而当时的Ｂｉｓａｃ并非是结构化的编程语言，且具有灵活性较差，速度慢的缺点，因此曾经在一段时间内Ｂｓ受到ａｉｃ了许多人的指责。随着ＶｓｌａｉｉｕｓａＢｃ的出现，修复和完善了Ｂｉｓａｃ的许多功能，留了其早期的一些特性，在原来的基础上有了进保步的发展。ＶＢ作为一个功能非常强大的计算机语言，为用户提供了轻松实现一般图形绘制的功能。二、系统总体设计基于Ｖ的交互式ＣＤ系统首先具备一个控制系统的主控ＢＡ窗口，它将交互式Ｃ的界面分为了绘图、编辑以及缩放三个ＤＡ方面，中绘图部分包括了直线、其多义线、以及圆弧四个方面；圆编辑部分包括了图形的缩放，其中所放下表现出放大、缩小、局部放大以及全屏显示四块内容。该系统的总体设计可以表现在下

VB对AutoCAD的二次开发方法介绍

万方数据
用程序自动地接收其它应用程序传送过来的数据，传送端有任何数据变动，接收端都可以自动更新，也可将命令或键盘输入传递给其它程序，实现远程控制。 !" 与 #)*+,#$ 都支持 $$& 功能，因此，它们之间可以进行数据及命令传递。传递方法有两种：必须建立起（ : ）直接利用 $$& 传递命令及数据：两者之间的 $$& 通道，其过程如图 : 所示。
图 : !" ; $$& ; #)*+,#$ 执行过程
（ - ）!" 通过 #$% 与 #)*+,#$ 连接：其实现过程如图 - 所示。
!" 应用程序 !"#$% 命令传送 !"#$% 命令给 $$&"#% ’ &(& $$&"#% 执行 #)*+,#$ 的 #$% 执行 #)*+,#$ 命令
引入对象库定义类的信息
客户（如 !" ）操作服务器（如 #)*+,#$ ）
图 < 客户、服务器和对象库关系图
一个应用程序在所展示的自动化对象之间，最好引入类库。在 !" 中引入 #)*+,#$ 对象的类库的方法如下： :’ 从 HI+J/5* 菜单，选择 HI/K/I/35/7 。 -’ 在 HI/K/I/35/7 对话框中，选择 #)*+,#$ 对象库，如果它未被列出，按下 "I+@7/ 按钮并在 #)*+,#$ 可执行文件的目录下选择 C5C?’*GL 文件。为了使用一个 =1& 自动化现象，必须完成以下几步：（ : ）为对象创建一个存储单元；（ - ）设置变量为一个引用对象或一个已存在的对象；（ < ）用对象的属性和方法编写代码。第一步工作是为对象创建一个存储单元即声明对象变量，如： H)LG25 C5C?#MM #7 =LJ/5* H)LG25 C5C?$+5 #7 =LJ/5* 第二步是设置变量为特定的对象，如： %/* C5C?#MMNO/*=LJ/5*PQR#)*+,#$’#MMG25C*2+3RS %/* C5C?$+5NC5C?#MM’#5*2B/$+5)9/3* 第三步便可以编写具体代码了。非常不直比较这四种方法，利用 “ %/3?4/87 ”命令，观，能够完成的功能十分有限，并且对 #)*+,#$ 的命令格式要十分熟悉才行；利用 $$& 功能可谓是提高了一且速度慢，能够完成的功能大步，但是 $$& 容易崩溃，虽然比 “ %/3?4/87 ”命令增加了一些，不过也只有几百 !" 并不能操纵 #)*+,#$ ，而只个罢了；利用 =1& 功能，是能在 !" 的环境中显示 #)*+,#$ ，要想实现一些绘图操作，还是要返回 #)*+,#$ 的环境中去才行。从而可见，最实用、简便，且功能最强的方法还是第四种。 #5; *2B/( #)*+9C*2+3 使用户几乎可以访问 #)*+,#$ 的所有功能。

CAD应用二次开发---VB和VBA开发CAD的知识

CAD应⽤⼆次开发---VB和VBA开发CAD的知识1、如何在 VB 中连接 AutoCAD。

启动 VB ，引⽤ AutoCAD 类型库。

操作步骤：从“⼯程”菜单中选择“引⽤”选项，启动“引⽤”对话框。

在“引⽤”对话框中，选择AutoCAD 类型库，然后单击“确定”。

定义模块级变量 AutoCAD 应⽤程序 (acadApp) 和当前的⽂档 (acadDoc)。

如果 AutoCAD 正在运⾏，使⽤ GetObject 函数将检索 AutoCAD Application 对象。

如果 AutoCAD 没有运⾏，使⽤CreateObject 函数试图创建⼀个 AutoCAD Application 对象。

如果创建成功，会启动 AutoCAD；如果失败，则会发⽣错误。

同时运⾏多个 AutoCAD 任务时，GetObject 函数会返回 Windows 运⾏对象表中的第⼀个 AutoCAD 实例。

要显⽰ AutoCAD 图形窗⼝，需要将 AutoCAD 应⽤程序的 Visible 特性设置为 TRUE。

使⽤ acadDoc 变量引⽤当前的 AutoCAD 图形。

⽰例：Dim acadApp As AcadApplicationDim acadDoc as AcadDocumentSub ConnectToAcad()On Error Resume NextSet acadApp = GetObject(, "AutoCAD.Application")If Err ThenErr.ClearSet acadApp = CreateObject("AutoCAD.Application")If Err Then EndEnd IfacadApp.Visible = TrueSet acadDoc = acadApp.ActiveDocumentEnd Sub2、如何使 VB 开发的程序不依赖于 AutoCAD 的版本。

VB交互式CAD系统开发与实现-编程源代码-VB毕业设计

Option ExplicitGlobal Const PI = 3.1415926'绘图模式Public Enu米GEDraw米odeed米Nor米al = 1ed米Select = 2ed米Delete = 3End Enu米'线型Public Enu米LineStylevbSolid = 0vbDash = 1vbDot = 2vbDashDot = 3vbDashDotDot = 4vbInvisible = 5vbInsideSolid = 6End Enu米'命令类型Public Enu米GECo米米andType ecUnknown = 0ecCreatePoint = 1ecCreateLine = 2ecCreatePolyLine = 3ecCreateCircle = 4ecCreateArc = 5ecCreateText = 6ecSelOnebyOne = 11ecSelLines = 12ecSelPolylines = 13ecSelCircles = 14ecSelArcs = 15ecSelTexts = 16ecSelAll = 17ecSelNone = 18e厘米ove = 21ecRotate = 22e厘米irror = 23ecviewzoo米in = 31ecViewZoo米Out = 32ecViewLocalZoo米Out = 33ecViewPan = 34ecViewExtent = 35End Enu米Public Type POINTAPIx As Longy As LongEnd TypePublic Type rectLeft As LongTop As LongRight As LongBotto米As LongEnd TypePublic sLeft As DoublePublic sTopic As DoublePublic sRight As DoublePublic sBotto米As DoublePublic Scal As DoublePublic ptLineBegin As New PositionPublic ptLineEnd As New PositionPublic ptPLPoints(1 To 100, 1 To 100) As New Position Public PLPoints(1 To 100, 1 To 100) As New Position Public intPLPointNu米As IntegerPublic ptCircleCenter As New PositionPublic ptCircleR As New PositionPublic ptArcCenter As New PositionPublic ptArcBegin As New PositionPublic ptArcEnd As New PositionPublic Co米米and As GECo米米andTypePublic GEle米ents As New CGEle米entsPublic lines As New CLinesPublic polylines As New CPolylinesPublic circles As New CCirclesPublic arcs As New CArcsPublic texts As New CTextsPublic SelLines As New CLineSelPublic SelPLines As New CPLineSelPublic SelCircles As New CCircleSelPublic SelArcs As New CArcSelPublic SelTexts As New CTextsPublic int米Step As IntegerPublic PickRadius As DoublePublic bol米irror As BooleanPublic intAr厘米irrorNu米As IntegerPublic ptBasePos As New PositionPublic ptDesPos As New PositionPublic pBasePos As New PositionPublic pDesPos As New PositionPublic scale1 As DoublePublic sinOriginX As DoublePublic sinOriginY As DoublePublic geNu米As IntegerPublic entCount As IntegerPublic Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As LongPublic Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As rect) As LongPublic Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As LongFunction distPtoP(Pos1 As Position, Pos2 As Position) As DoubleDi米disx As Double, disy As Double, dist As DoubleWith Pos1disx = .x - Pos2.xdisy = .y - Pos2.yEnd WithdistPtoP = Sqr(disx * disx + disy * disy)'distPtoP = (disx + disy + 2 * 米ax(disx, disy)) / 3End Function'计算点到直线的距离Function distPtoL(pos As Position, CLine1 As CLine) As DoubleDi米k As DoubleDi米C As DoubleDi米px As Double, py As DoubleDi米distX As Double, distY As DoubleWith pospx = .xpy = .yEnd WithCall CLine1.LineKX(k, C)If k = 0 ThendistX = 10000distY = Abs(py - CLine1.pLineBegin.y)ElseIf k = 10000 ThendistX = Abs(px - CLine1.pLineBegin.x)distY = 10000ElsedistX = Abs(px - (py - C) / k)distY = Abs(py - (k * px + C))End IfdistPtoL = 米in(distX, distY)End FunctionFunction GetAngle(pBegin As Position, pEnd As Position) As DoubleDi米tansita As DoubleDi米sita As DoubleDi米subEBx As DoublesubEBx = Abs(pEnd.x - pBegin.x)If pEnd.x = pBegin.x Then subEBx = 0.0001tansita = (Abs(pEnd.y - pBegin.y)) / subEBxsita = Atn(tansita)'如果终点横坐标大于起点横坐标,并且终点纵坐标大于起点纵坐标If pEnd.x >= pBegin.x And pEnd.y >= pBegin.y ThenGetAngle = sita'如果终点横坐标小于起点横坐标,并且终点纵坐标大于起点纵坐标ElseIf pEnd.x <= pBegin.x And pEnd.y >= pBegin.y ThenGetAngle = PI - sita'如果终点横坐标小于起点横坐标,并且终点纵坐标小于起点纵坐标ElseIf pEnd.x <= pBegin.x And pEnd.y <= pBegin.y ThenGetAngle = PI + sita'如果终点横坐标大于起点横坐标,并且终点纵坐标小于起点纵坐标ElseIf pEnd.x >= pBegin.x And pEnd.y <= pBegin.y ThenGetAngle = 2 * PI - sitaEnd IfEnd FunctionFunction InBox(Box As Box, curpos As Position) As BooleanIf curpos.x > Box.米inX And curpos.y > Box.米inY _ And curpos.x < Box.米axX And curpos.y < Box.米axY Then InBox = TrueElseInBox = FalseEnd IfEnd FunctionFunction 米in(la As Double, lb As Double) As DoubleIf la < lb Then米in = laElse米in = lbEnd IfEnd FunctionFunction 米ax(la As Double, lb As Double) As DoubleIf la > lb Then米ax = laElse米ax = lbEnd IfEnd FunctionPublic Sub ReDraw(d米ode As GEDraw米ode)Di米pLine As New CLineDi米pPLine As New CPolyLineDi米pCircle As New CCircleDi米pArc As New CArcDi米pText As New CTextDi米pGEle米ent As CGEle米entDi米i As Integer'按指定绘图模式重绘所有图元For Each pLine In linesSet pGEle米ent = pLinepGEle米ent.Draw (d米ode)NextFor Each pPLine In polylinesSet pGEle米ent = pPLinepGEle米ent.Draw (d米ode)NextFor Each pCircle In circlesSet pGEle米ent = pCirclepGEle米ent.Draw (d米ode) NextFor Each pArc In arcsSet pGEle米ent = pArcpGEle米ent.Draw (d米ode) NextFor Each pText In textsSet pGEle米ent = pTextpGEle米ent.Draw (d米ode) NextEnd SubPublic Sub SelDraw()Di米pLine As New CLineDi米pPLine As New CPolyLineDi米pCircle As New CCircleDi米pArc As New CArcDi米pText As New CTextDi米pGEle米ent As CGEle米ent Di米i As Integer'按指定绘图模式重绘所有图元For Each pLine In SelLinesSet pGEle米ent = pLinepGEle米ent.Draw (ed米Delete)pGEle米ent.Draw (ed米Select) NextFor Each pPLine In SelPLinesSet pGEle米ent = pPLinepGEle米ent.Draw (ed米Delete)pGEle米ent.Draw (ed米Select) NextFor Each pCircle In SelCirclesSet pGEle米ent = pCirclepGEle米ent.Draw (ed米Delete)pGEle米ent.Draw (ed米Select) NextFor Each pArc In SelArcsSet pGEle米ent = pArcpGEle米ent.Draw (ed米Delete)pGEle米ent.Draw (ed米Select)NextFor Each pText In SelTextsSet pGEle米ent = pTextpGEle米ent.Draw (ed米Delete)pGEle米ent.Draw (ed米Select)NextEnd SubPublic Function SelEntityNu米() As IntegerSelEntityNu米= SelLines.Count + SelPLines.Count + SelCircles.Count + SelArcs.Count End Function'删除所有选择集中的图元Public Sub SelRe米ove()Di米i As IntegerDi米intLCount As IntegerDi米intPLCount As IntegerDi米intCCount As IntegerDi米intACount As IntegerintLCount = SelLines.CountintPLCount = SelPLines.CountintCCount = SelCircles.CountintACount = SelArcs.CountWith SelLinesFor i = intLCount To 1 Step -1.Re米ove (i)Next iEnd WithWith SelPLinesFor i = intPLCount To 1 Step -1.Re米ove (i)Next iEnd WithWith SelCirclesFor i = intCCount To 1 Step -1.Re米ove (i)Next iEnd WithWith SelArcsFor i = intACount To 1 Step -1.Re米ove (i)End WithEnd Sub'彻底删除所有选择集中的图元Public Sub AllSelRe米ove()Di米i As IntegerDi米intLCount As IntegerDi米intPLCount As IntegerDi米intCCount As IntegerDi米intACount As IntegerDi米intTCount As IntegerintLCount = SelLines.CountintPLCount = SelPLines.CountintCCount = SelCircles.CountintACount = SelArcs.CountintTCount = SelTexts.Count'删除直线图元选择集中的所有图元'并从直线段集合类中删除对应图元With SelLinesFor i = intLCount To 1 Step -1lines.Re米ove (Str(.Ite米(i).ID_Line)).Re米ove (i)Next iEnd With'删除多义线图元选择集中的所有图元'并从多义线集合类中删除对应图元With SelPLinesFor i = intPLCount To 1 Step -1polylines.Re米ove (Str(.Ite米(i).ID_PLine)).Re米ove (i)Next iEnd With'删除圆类图元选择集中的所有图元'并从圆集合类中删除对应图元With SelCirclesFor i = intCCount To 1 Step -1circles.Re米ove (Str(.Ite米(i).ID_Circle)).Re米ove (i)Next i'删除圆弧图元选择集中的所有图元'并从圆弧集合类中删除对应图元With SelArcsFor i = intACount To 1 Step -1arcs.Re米ove (Str(.Ite米(i).ID_Arc)).Re米ove (i)Next iEnd With'删除文本图元选择集中的所有图元'并从文本集合类中删除对应的图元With SelTextsFor i = intTCount To 1 Step -1texts.Re米ove (Str(.Ite米(i).ID_Text)).Re米ove (i)Next iEnd WithEnd Sub'根据不同的选择方式选择图元Public Sub SelectGEs(SelType As GECo米米andType)Di米pGEle米ent As New CGEle米entDi米pLine As New CLineDi米pPLine As New CPolyLineDi米pCircle As New CCircleDi米pArc As New CArcDi米pText As New CTextDi米PLPoints(1 To 100, 1 To 100) As PositionDi米i As IntegerDraw米ain.picDraw.Draw米ode = 13Select Case SelTypeCase ecSelLinesReDraw (ed米Nor米al)SelRe米oveIf lines.Count > 0 ThenFor Each pLine In linesSet pGEle米ent = pLineWith pGEle米ent.Draw (ed米Delete).Draw (ed米Select) '用选择模式绘图元End With'将图元添加到选择集SelLines中With pLineCallSelLines.Add(.geLineWidth, .geLineStyle, .geColor, .ID_Line, .pLineBegin, .pLineEnd) End WithNextEnd IfCase ecSelPolylinesReDraw (ed米Nor米al)SelRe米oveIf polylines.Count > 0 ThenFor Each pPLine In polylinesWith pPLineFor i = 1 To .intPLinePointNu米Set PLPoints(.ID_PLine, i) = .pPLPoints(.ID_PLine, i)Next iEnd WithSet pGEle米ent = pPLineWith pGEle米ent.Draw (ed米Delete).Draw (ed米Select)End WithWith pPLineCall SelPLines.Add(.intPLinePointNu米, PLPoints(), .geLineWidth, .geLineStyle, .geColor, .ID_PLine)End WithNextEnd IfCase ecSelCirclesReDraw (ed米Nor米al)SelRe米oveIf circles.Count > 0 ThenFor Each pCircle In circlesSet pGEle米ent = pCircleWith pGEle米ent.Draw (ed米Delete).Draw (ed米Select)End WithWith pCircleCallSelCircles.Add(.geLineWidth, .geLineStyle, .geColor, .pCircleR, .pCenter, .ID_Circle)NextEnd IfCase ecSelArcsReDraw (ed米Nor米al)SelRe米oveIf arcs.Count > 0 ThenFor Each pArc In arcsSet pGEle米ent = pArcWith pGEle米ent.Draw (ed米Delete).Draw (ed米Select)End WithWith pArcCallSelArcs.Add(.geLineWidth, .geLineStyle, .geColor, .pCenter, .pBegin, .pEnd, .ID_Arc) End WithNextEnd IfCase ecSelTextsReDraw (ed米Nor米al)SelRe米oveIf texts.Count > 0 ThenFor Each pText In textsSet pGEle米ent = pTextWith pGEle米ent.Draw (ed米Select)End WithWith pTextCall SelTexts.Add(.x, .y, .Height, .Wide, .Content, .geColor, .ID_Text)End WithNextEnd IfCase ecSelAllReDraw (ed米Nor米al)If GEle米ents.Count > 0 ThenFor Each pLine In linesSet pGEle米ent = pLineWith pGEle米ent.Draw (ed米Delete).Draw (ed米Select) '用选择模式绘图元'将图元添加到选择集SelLines中With pLineCallSelLines.Add(.geLineWidth, .geLineStyle, .geColor, .ID_Line, .pLineBegin, .pLineEnd) End WithNextEnd IfIf polylines.Count > 0 ThenFor Each pPLine In polylinesWith pPLineFor i = 1 To .intPLinePointNu米Set PLPoints(.ID_PLine, i) = .pPLPoints(.ID_PLine, i)Next iEnd WithSet pGEle米ent = pPLineWith pGEle米ent.Draw (ed米Delete).Draw (ed米Select)End WithWith pPLineCall SelPLines.Add(.intPLinePointNu米, PLPoints(), .geLineWidth, .geLineStyle, .geColor, .ID_PLine)End WithNextEnd IfIf circles.Count > 0 ThenFor Each pCircle In circlesSet pGEle米ent = pCircleWith pGEle米ent.Draw (ed米Delete).Draw (ed米Select)End WithWith pCircleCallSelCircles.Add(.geLineWidth, .geLineStyle, .geColor, .pCircleR, .pCenter, .ID_Circle) End WithNextEnd IfIf arcs.Count > 0 ThenFor Each pArc In arcsSet pGEle米ent = pArcWith pGEle米ent.Draw (ed米Delete).Draw (ed米Select)End WithWith pArcCallSelArcs.Add(.geLineWidth, .geLineStyle, .geColor, .pCenter, .pBegin, .pEnd, .ID_Arc) End WithNextEnd IfIf texts.Count > 0 ThenFor Each pText In textsSet pGEle米ent = pTextWith pGEle米ent.Draw (ed米Select)End WithWith pTextCall SelTexts.Add(.x, .y, .Height, .Wide, .Content, .geColor, .ID_Text)End WithNextEnd IfCase ecSelNoneReDraw (ed米Nor米al)Call SelRe米oveEnd SelectEnd SubPublic Sub Coordinate()Draw米ain.picDraw.Scale (sLeft, sTopic)-(sRight, sBotto米)Draw米ain.picDraw.RefreshEnd SubOption ExplicitPrivate Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPrivate Const SWP_NOSIZE = &H1Private Const SWP_NO米OVE = &H2Private Const HWND_TOP米OST = -1Private Const HWND_NOTOP米OST = -2Di米X01 As Double, Y01 As Double, X02 As Double, Y02 As Double, BX As Double, BY As DoublePrivate bolHandleShow As BooleanPrivate bolEntitySizing As BooleanPrivate Sub About_Click()fr米About.ShowEnd SubPrivate Sub Arc_Click()Co米米and = ecCreateArcEnd SubPrivate Sub Circle_Click()Co米米and = ecCreateCircleEnd SubPrivate Sub Delete_Click()'删除被选中的所有图元AllSelRe米ove'更新图片框中的内容Draw米ain.picDraw.RefreshEnd SubPrivate Sub Extent_Click()Di米米inX As DoubleDi米米inY As DoubleDi米米axX As DoubleDi米米axY As DoubleDi米rc As rectDi米rcLB As New PositionDi米rcRT As New PositionDi米scalex As Double, scaley As DoubleCall GetClientRect(Draw米ain.picDraw.hwnd, rc)With rcLB.x = rc.Left * Screen.TwipsPerPixelX.y = rc.Botto米* Screen.TwipsPerPixelYEnd WithWith rcRT.x = rc.Right * Screen.TwipsPerPixelX.y = rc.Top * Screen.TwipsPerPixelYEnd WithCall GetExtentBox(米inX, 米inY, 米axX, 米axY)'计算新坐标系与逻辑坐标的比例因子scalex = Abs((rcRT.x - rcLB.x) / (米axX - 米inX))scaley = Abs((rcRT.y - rcLB.y) / (米axY - 米inY))scale1 = 米in(scalex, scaley)'重新设置视口大小sLeft = 米inXsTopic = 米axYIf scalex < scaley Then米inY = 米axY - (米axX - 米inX) * ScalElse米axX = 米inX + (米axY - 米inY) / ScalEnd IfsRight = 米axXsBotto米= 米inYCall CoordinateEnd SubPrivate Sub For米_Load()'显示启动窗口fr米Flash.ShowSetWindowPos fr米Flash.hwnd, HWND_TOP米OST, 0, 0, 0, 0, SWP_NO米OVE Or SWP_NOSIZEDraw米ain.picDraw.Draw米ode = 6PickRadius = 0.05Co米米and = 0intAr厘米irrorNu米= 0bol米irror = Falsescale1 = 1With picDrawScal = .ScaleHeight / .ScaleWidth.ScaleWidth = 640 * 15.ScaleHeight = .ScaleWidth * Scal End WithsLeft = -320 * 15sTopic = picDraw.ScaleHeight / 2 sRight = -320 * 15 + picDraw.ScaleWidth sBotto米= -picDraw.ScaleHeight / 2 Call CoordinateEnd SubPrivate Sub picDraw_Paint()ReDraw (ed米Nor米al)SelDrawEnd SubPrivate Sub For米_Resize()picDraw.RefreshEnd SubPrivate Sub Line_Click()Co米米and = ecCreateLineEnd SubPrivate Sub localEnlarge_Click()Co米米and = ecViewZoo米OutEnd SubPrivate Sub localZoo米Out_Click()Co米米and = ecViewLocalZoo米Out End SubPrivate Sub 米irror_Click()Co米米and = e厘米irrorEnd SubPrivate Sub 米ove_Click()Co米米and = e厘米oveEnd SubPrivate Sub SelNone_Click()SelectGEs (ecSelNone)End SubPrivate Sub picDraw_米ouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Di米pPos As New PositionDi米lpPoint As New PositionDi米pCo米米and As CCo米米andDi米pCreateLine As New CCreateLineDi米pCreatePolyline As New CCreatePolyLineDi米pCreateCircle As New CCreateCirceDi米pCreateArc As New CCreateArcDi米pCreateText As New CCreateTextDi米pSelect As New CSelectDi米p米ove As New 厘米oveDi米pRotate As New CRotateDi米p米irror As New 厘米irrorDi米pViewLocalZoo米Out As New CViewLocalZoo米OutDi米pViewPan As New CviewPanOn Error Resu米e NextWith pPos.x = x.y = yEnd WithIf Button = vbLeftButton ThenSelect Case Co米米andCase ecCreateLineSet pCo米米and = pCreateLineCase ecCreatePolyLineSet pCo米米and = pCreatePolylineCase ecCreateCircleSet pCo米米and = pCreateCircleCase ecCreateArcSet pCo米米and = pCreateArcCase ecCreateTextSet pCo米米and = pCreateTextCase ecSelOnebyOneSet pCo米米and = pSelectCase e厘米oveSet pCo米米and = p米oveCase ecRotateSet pCo米米and = pRotateCase e厘米irrorSet pCo米米and = p米irrorCase ecViewLocalZoo米OutSet pCo米米and = pViewLocalZoo米OutCase ecViewPanSet pCo米米and = pViewPanEnd SelectCall pCo米米and.LButtonDown(pPos)ElseIf Button = vbRightButton ThenSelect Case Co米米andCase ecCreateLineSet pCo米米and = pCreateLineCase ecCreatePolyLineSet pCo米米and = pCreatePolylineCase ecCreateCircleSet pCo米米and = pCreateCircleCase ecCreateArcSet pCo米米and = pCreateArcCase ecCreateTextSet pCo米米and = pCreateTextCase e厘米oveSet pCo米米and = p米oveCase ecRotateSet pCo米米and = pRotateCase e厘米irrorSet pCo米米and = p米irrorCase ecViewLocalZoo米OutSet pCo米米and = pViewLocalZoo米OutCase ecViewPanSet pCo米米and = pViewPanEnd SelectCall pCo米米and.RButtonDown(pPos)End IfEnd SubPrivate Sub picDraw_米ouse米ove(Button As Integer, Shift As Integer, x As Single, y As Single) Di米pPos As New PositionDi米lpPoint As New PositionDi米pCreateLine As New CCreateLineDi米pCreatePolyline As New CCreatePolyLineDi米pCreateCircle As New CCreateCirceDi米pCreateArc As New CCreateArcDi米pCreateText As New CCreateTextDi米pSelect As New CSelectDi米p米ove As New 厘米oveDi米pRotate As New CRotateDi米p米irror As New 厘米irrorDi米pCo米米and As New CCo米米andDi米pViewLocalZoo米Out As New CViewLocalZoo米Out Di米pViewPan As New CviewPanStatusBar1.Panels(1).Text = "X=" & Str(x) & " Y=" & Str(y)With pPos.x = x.y = yEnd WithSelect Case Co米米andCase ecCreateLineSet pCo米米and = pCreateLineCase ecCreatePolyLineSet pCo米米and = pCreatePolylineCase ecCreateCircleSet pCo米米and = pCreateCircleCase ecCreateArcSet pCo米米and = pCreateArcCase ecCreateTextSet pCo米米and = pCreateTextCase e厘米oveSet pCo米米and = p米oveCase ecRotateSet pCo米米and = pRotateCase e厘米irrorSet pCo米米and = p米irrorCase ecViewLocalZoo米OutSet pCo米米and = pViewLocalZoo米OutCase ecViewPanSet pCo米米and = pViewPanEnd SelectCall pCo米米and.米ouse米ove(pPos)End SubPrivate Sub SelAll_Click()SelectGEs (ecSelAll)End SubPrivate Sub SelArc_Click()SelectGEs (ecSelArcs)End SubPrivate Sub SelCircle_Click() SelectGEs (ecSelCircles)End SubPrivate Sub SelLine_Click() SelectGEs (ecSelLines)End SubPrivate Sub SelOnebyOne_Click() Co米米and = ecSelOnebyOne End SubPrivate Sub SelPolyline_Click() SelectGEs (ecSelPolylines)End SubPrivate Sub SelText_Click() SelectGEs (ecSelTexts)End SubPrivate Sub PolyLine_Click()Co米米and = ecCreatePolyLine End SubPrivate Sub Rotate_Click()Co米米and = ecRotateEnd SubPrivate Sub ScaleZoo米In_Click() Call ScaleZoo米(0.8, 0.8)End SubPrivate Sub ScaleZoo米Out_Click() Call ScaleZoo米(1.2, 1.2)End SubPrivate Sub SnapTo_Click() SnapToGrid = TrueEnd SubPrivate Sub Text_Click()Co米米and = ecCreateTextEnd SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As 米SCo米ctlLib.Button) Select Case Button.KeyCase "Select"SelOnebyOne_ClickCase "Line"Line_ClickCase "Polyline"PolyLine_ClickCase "Circle"Circle_ClickCase "Arc"Arc_ClickCase "Text"Text_ClickCase "米ove"米ove_ClickCase "Rotate"Rotate_ClickCase "米irror"米irror_ClickCase "Zoo米O"ScaleZoo米Out_ClickCase "Zoo米I"ScaleZoo米In_ClickCase "Zoo米Out"Zoo米Out_ClickCase "Zoo米In"Zoo米In_ClickCase "Zoo米Local"localZoo米Out_ClickCase "Extent"Extent_ClickCase "G米ove"ViewPan_ClickEnd SelectEnd SubPrivate Sub ViewPan_Click()Co米米and = ecViewPanEnd SubPrivate Sub Zoo米In_Click()sLeft = sLeft * 1.2sRight = sRight * 1.2sTopic = sTopic * 1.2sBotto米= sBotto米* 1.2Call CoordinateEnd SubPrivate Sub ScaleZoo米(scalex As Double, scaley As Double)Di米i As IntegerDi米pLine As New CLineDi米pPLine As New CPolyLineDi米pCircle As New CCircleDi米pArc As New CArcDi米pGEle米ent As New CGEle米entDraw米ain.picDraw.Draw米ode = 13If SelEntityNu米() > 0 ThenFor Each pLine In SelLinesSet pGEle米ent = pLineWith pGEle米ent.Draw (ed米Delete) '清除原来位置上的图元Call .ScaleTransfor米(scalex, scaley).Draw (ed米Select)End WithWith pLinelines.Re米ove (Str(.ID_Line))Calllines.Add(.geLineWidth, .geLineStyle, .geColor, .ID_Line, .pLineBegin, .pLineEnd, Str(.ID_Line))End WithNextFor Each pPLine In SelPLinesSet pGEle米ent = pPLineWith pGEle米ent.Draw (ed米Delete)Call .ScaleTransfor米(scalex, scaley).Draw (ed米Select)End WithWith pPLineDi米PLPoints(1 To 100, 1 To 100) As PositionFor i = 1 To .intPLinePointNu米Set PLPoints(.ID_PLine, i) = .pPLPoints(.ID_PLine, i)Next ipolylines.Re米ove (Str(.ID_PLine))Call polylines.Add(.intPLinePointNu米, PLPoints, .geLineWidth, .geLineStyle, .geColor, .ID_PLine, Str(.ID_PLine))End WithNextFor Each pCircle In SelCirclesSet pGEle米ent = pCircleWith pGEle米ent.Draw (ed米Delete)Call .ScaleTransfor米(scalex, scaley).Draw (ed米Select)End WithWith pCirclecircles.Re米ove (Str(.ID_Circle))Callcircles.Add(.geLineWidth, .geLineStyle, .geColor, .pCircleR, .pCenter, .ID_Circle, Str(.ID_Circle))End WithNextFor Each pArc In SelArcsSet pGEle米ent = pArcWith pGEle米ent.Draw (ed米Delete)Call .ScaleTransfor米(scalex, scaley).Draw (ed米Select)End WithWith pArcarcs.Re米ove (Str(.ID_Arc))Callarcs.Add(.geLineWidth, .geLineStyle, .geColor, .pCenter, .pBegin, .pEnd, .ID_Arc, Str(.ID_Arc)) End WithNextEnd IfDraw米ain.picDraw.Draw米ode = 6End SubPrivate Sub Zoo米Out_Click()sLeft = sLeft * 0.8sRight = sRight * 0.8sTopic = sTopic * 0.8sBotto米= sBotto米* 0.8Call CoordinateEnd SubPrivate Sub GetExtentBox(米inX As Double, 米inY As Double, 米axX As Double, 米axY As Double)Di米pLine As New CLineDi米pPLine As New CPolyLineDi米pCircle As New CCircleDi米pArc As New CArcDi米pText As New CTextDi米pGEle米ent As CGEle米entDi米sourceBox As New BoxDi米i As Integer'给矩形对角顶点的坐标赋初值米inX = 0米inY = 0米axX = 0米axY = 0'按指定绘图模式重绘所有图元For Each pLine In linesWith pLineSet ptLineBegin = .pLineBeginSet ptLineEnd = .pLineEndEnd WithSet pGEle米ent = pLineCall pGEle米ent.GetBox(sourceBox)With sourceBox米inX = 米in(米inX, .米inX)米inY = 米in(米inY, .米inY)米axX = 米ax(米axX, .米axX)米axY = 米ax(米axY, .米axY)End WithNextFor Each pPLine In polylinesWith pPLineintPLPointNu米= .intPLinePointNu米For i = 1 To intPLPointNu米Set ptPLPoints(.ID_PLine, i) = .pPLPoints(.ID_PLine, i)Next iEnd WithSet pGEle米ent = pPLineCall pGEle米ent.GetBox(sourceBox)With sourceBox米inX = 米in(米inX, .米inX)米axX = 米ax(米axX, .米axX)米axY = 米ax(米axY, .米axY) End WithNextFor Each pCircle In circlesWith pCircleSet ptCircleCenter = .pCenterSet ptCircleR = .pCircleREnd WithSet pGEle米ent = pCircleCall pGEle米ent.GetBox(sourceBox) With sourceBox米inX = 米in(米inX, .米inX)米inY = 米in(米inY, .米inY)米axX = 米ax(米axX, .米axX)米axY = 米ax(米axY, .米axY) End WithNextFor Each pArc In arcsWith pArcSet ptArcCenter = .pCenterSet ptArcBegin = .pBeginSet ptArcEnd = .pEndEnd WithSet pGEle米ent = pArcCall pGEle米ent.GetBox(sourceBox) With sourceBox米inX = 米in(米inX, .米inX)米inY = 米in(米inY, .米inY)米axX = 米ax(米axX, .米axX)米axY = 米ax(米axY, .米axY) End WithNextFor Each pText In textsSet pGEle米ent = pTextCall pGEle米ent.GetBox(sourceBox) With sourceBox米inX = 米in(米inX, .米inX)米inY = 米in(米inY, .米inY)米axX = 米ax(米axX, .米axX)End With NextEnd Sub。

毕业设计说明书用vb进行autocad二次开发[管理资料]

1 引言AutoCAD工程图形处理软件，自1982年由美国Autodesk公司开发面世以来，以其完善的绘图功能、良好的用户界面、易学易用的特点，受到了广大工程技术人员的普遍欢迎目前遍布150个国家和地区。

AutoCAD 是目前微机上应用最为广泛的通用的交互式计算机辅助绘图与设计软件包。

AutoCAD的强大生命力在于它的通用性、多种工业标准和开放的体系结构。

其通用性使得它在机械、电子、航空、轮船、建筑、服装等领域得到了极为广泛的应用，是CAD工业的旗帜产品。

AutoCAD及其图形格式已经成为一种事实上的国际工业标准。

AutoCAD之所以得到广泛应用，一个重要原因还在于它开放的结构体系，即用户根据自己的需要，对其进行二次开发。

VB（Visual Basic）是目前开发windows应用程序最为迅速、简捷的程序设计语言，具有功能强大、易于掌握的特点，能够直接用它进行Word、Excel和AutoCAD 二次开发。

全世界近千万的专业和非专业程序设计人员正在用VB开发各种类型的软件。

我国高校已经把VB列入高等教育教学计划。

用VB进行AutoCAD二次开发，是AutoCAD R14以后的一种新技术，我们可以用VB语言编程，将AutoCAD当成自己VB程序中的一个图形窗口，对其进行打开、绘图、编辑、打印、关闭等操作，十分方便。

用VB进行AutoCAD二次开发，不仅简单易学、功能强大，还能实现仅用AutoCAD不能或不易实现的功能和效果，例如进行三维动画模拟、图形参数化设计等。

用VB进行AutoCAD二次开发，不论是用于理论研究，实现自己的梦想，还是用于程序设计，开发面向实际工程呢问题的软件，均是十分有效的手段和方法。

2008进行二次开发，将AutoCAD2008窗口当成VB程序中的一个图形窗口,以平面机构-三轮式齿轮连杆机构为例,根据机构参数对其运动进行动态演示,并分析该机构的运动特性。

由于本人的水平有限，本说明书中的疏漏和错误之处在所难免，恳请老师和同学们批评指正。

1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。

用VB开发交互式cad系统摘要本次毕业设计的任务是利用VB开发交互式cad系统中的图形的编辑部分。

设计具有交互绘图的功能。

能实现鼠标绘图、图元选择和编辑，具备图形输出功能。

实现交互式绘图过程涉及到图元的数学模型，数据管理、数据编辑等方面的知识和技巧。

图元的选择编辑的重点放在了图元的平移和旋转。

此外还设计了的启动窗口和窗口的显示。

交互式cad技术在办公、绘图平面设计、工业设计等方面都有很多应用。

关键字：交互式cad 图形的编辑窗口AbstractThis graduation project duty is develops in the interactive cad system the graph edition part. The design has the alternately cartography the function. Can realize the mouse cartography, a chart Yuan choice and the edition, has the graphical output function. Realizes the interactive cartography process to involve to the chart Yuan mathematical model, aspect the and so on data management, data edition knowledge and the skill. The chart Yuan choice edition key point has placed a chart Yuan translation and revolves. In addition also has designed start window and window demonstration. The interactive cad technology in aspect and so on work, cartography plane design, industrial design all has applies very much.Key words: Interactive cad graph edition Window目录第1章绪论 (5)第2章可行性研究 (6)2.1 问题定义2.2 可行性分析第3章总体设计 (7)3.1 总体规划3.2 开发环境和工具3.3 软件介绍3.4系统实现和设计主要分以下几个步骤第4章具体设计 (8)4.1具体设计的详细说明图 (9)4.2 图元的编辑 (10)4.3 图元的拾取与选择 (15)4.4 窗体的显示控制 (19)第5章心得体会 (20)参考资料 (21)第一章绪论对于大多数人而言，“交互式cad技术”是一个熟悉而陌生的概念，为什么这么说呢？因为您可能经常在使用这种技术，却没有意识到。

什么是交互式cad 技术呢？打一个比方说；用鼠标在屏幕上画一条直线，选中它后，可以改变直线段的方位和长度。

这种技术绘图具有方便、直观、高效率等特点，在各种专业软件、数据处理软件、AutoCAD、Flash、PowerPoint、Word等很很多软件里面都有广泛的应用。

在交互式系统中，不仅可以实现用鼠标绘图，还可以选择图元，并对选中的图元进行修改、几何变换和删除等操作。

为了实现这些功能，交互式CAD系统不仅需要考虑图形的数学模型，还要在数据结构、内存管理等方面做出筹划。

可行性研究2.1 问题定义本系统是一个关于交互式CAD的应用系统。

（1）该系统应该在整体上实现绘制各种图元、编辑图元和显示编辑好的窗体等模块。

（2）该系统中，图元数据需要保存起来，以便进行编辑操作。

以合理的数据结构进行保存，可以在内存、系统安全性方面得到好处,从而提高程序的整体性能。

2.2 可行性分析技术可行性：根据新系统目标来衡量所需的技术是否具备，一般可以从硬件、软件的性能要求、环境条件、技术人员水平和数量等方面去考虑和分析。

这次设计的系统采用Visual basic 6.0系统开发的。

硬件要求：486以上CPU, 64MB以上内存，2G以上硬盘。

第三章总体设计交互式CAD系统要涉及到大量的数据处理，如何描述、输入、管理、编辑和输出它们，在开发以前需要进行详细的规划。

3.1 总体规划1. 数据的组织和描述（1）数据结构（2）数学模型2. 数据的输入实现鼠标交互式输入数据3. 数据的管理type结构VB类4. 数据编辑图元的拾取和选择图元的几何变化－平移和旋转。

5. 数据的输出（1）文本输出（2）以DXF格式输出6. UML类图7. 界面交互3.2 开发环境和工具windows平台Visual basic 6.03.3 软件介绍Visual basic 6.0为开发工具。

VB6.0是微软公司推出的可视化编程工具MSDN之一， Visual basic 6.0是一门功能强大的计算机语言，为用户提供了一系列的属性、方法和控件。

采用了面向对象的编程技术进行编程。

3.4系统实现和设计主要分以下几个步骤1.在windows平台下安装Visual basic 6.0软件。

2.创建主窗体和显示控制窗体。

3.用Visual basic 6.0语言来编写程序。

第四章具体设计设计图元编辑的流程图具体设计的详细说明图本次设计包括三个部分；图元的拾取、图元的编辑和窗体的制作。

总体设计过程说明图图元编辑说明图图元拾取的功能分析图4.2图元的编辑在设计过程中图元编辑部分是具体设计的核心部分。

一. 二维图形变换的基本原理、算法和具体实现用计算机进行辅助设计时，复制、移动、旋转已有图元可以提高绘图效率，对图形元素进行集合变换可以实现这些操作。

图元的基本形状和位置由它们的控制点唯一确定，比如直线段由直线段的起点和终点确定，圆弧由圆弧的圆心、起点和终点确定等。

所以对图元的旋转、平移等集合变换可以归结为对图元控制点的几何变换。

控制点的几何变换完成以后，根据变换后的控制点绘图，就可得到变换后的图元。

二维空间中一点变换前后的关系可用下式表示：t11t12[x´ y´ 1 ]= [ x y 1] t21t22Δx Δy其中，[ x y ] 为变换前点的坐标，[x´ y´] 为变换后的坐标。

t11t12T = t21t22 变换矩阵。

Δx Δy用齐次坐标表示，上式可以写成：x´=x t11+y t21+Δxy´=y t12+y t22+Δy（1）平移变换平移变换是把选中的图元平移到另一位置,如图2-1所示。

X平移变换的变换矩阵为10 0T = 0 1 0Δx Δy 1所以有10 0[x´ y´ 1 ]= [ x y 1] 0 1 0Δx Δy 1既x´=x+Δxy´=y+Δy其中，x，y 为评议前点的坐标；x´，y´为平移后点的坐标，Δx和Δy为点在x方向和y方向上平移的距离。

（2）旋转变换旋转变换使图元绕某点旋转一定角度后，到达新位置，如图2-2所示。

逆时针旋转时，旋转角度为正，反之为负。

Xcosθsinθ0饶原点旋转的变换矩阵为T = -sinθcosθ000 1所以有cosθsinθ0 [x´ y´ 1 ]= [ x y 1] T = -sinθcosθ0001即x´=x cosθ－y sinθy´= x sinθ+y cosθ一. 点的变换图元的变换可以归结为点的变换，首先在position类中添加点的变换函数。

平移变换移动后点的坐标值等于移动前点的坐标值与位移矢量的和。

在position类中添加pntmove函数，该函数有两个参数xx和yy,分别定义移动矢量的水平向分量和垂直向分量。

在直角坐标系中，当xx或yy为正时，点向右、向上移动；当xx或yy为负时，点向左、向下移动。

函数返回一个position类实例，为移动后的点。

（2）旋转变换旋转一个点需要确定两个参数，既旋转的参照点和旋转的角度。

参照点指的是饶哪个点旋转。

在position类中添加pntrotate函数,定义点的旋转行为。

Pntrotate 函数有两个参数，即basepos和angle分别定义旋转参照点和旋转角度。

旋转后点的坐标可以根据原理部分的计算公式获得。

,二. 图元的变换1.直线段的几何变换（1）直线段的平移变换直线段的平移变换实际上是对直线段的起点和终点作平移变换，然后将变换后的起点和终点用直线段相连接。

在cline类模块中添加CGElement_Move过程，定义直线段的平移变换。

该函数有两个参数，即basepos和despos，分别定义平移前后的相对位置。

平移前直线段上任一点到basepos点的距离和方向与平移后直线段上对应点到despos点的距离和方向是相同的。

两个点横坐标之间和纵坐标之间的差异分别表示横向和纵向移动的距离和方向。

'（2）直线段的旋转变换通过旋转直线段的起点和终点，可以实现直线段的旋转。

在cline类模块中添加CGElement_Rotate过程，该过程的两个参数basepos和angle分别定义旋转的基点和角度。

2.多义线的几何变换（1）多义线的平移变换多义线的平移变换可通过平移多义线的顶点来实现。

在cpolyline类模块中添加CGElement_Move过程，以描述多义线的平移变换。

（2）多义线的旋转变换在cpolyline类模块中添加CGElement_Rotate过程，通过对多义线的顶点进行旋转变换来实现多义线的旋转变换。

3. 圆的几何变换（1）圆的平移变换圆的平移动变换通过对圆的圆心和圆上一点进行平移变换类实现。

在ccircle 类模块中添加CGElement_Move函数，描述圆的平移变换。

（2）圆的旋转变换在ccircle类模块中添加CGElement_Rotate过程，通过对圆心和圆上一点进行旋转变换来实现圆的旋转变换。

4. 圆弧的几何变换1.圆弧的平移变换在carc类模块中添加CGElement_Move过程，实现圆弧的平移变换。

（2）圆弧的旋转变换在carc类模块中添加CGElement_Rotate过程，对圆弧的圆心、起点和终点进行旋转变换。

2.3 图形变换交互功能的实现2.3.1 平移变换—CMOVE类平移变换的交互过程通过CMOVE类来实现。

该类利用鼠标单击和移动事件代码来描述各种图元进行平移变换时的交互过程。

该类实现了Ccommand接口。

2.3.2旋转变换通过创建CRotate类来进行描述。