VB用VB开发交互式CAD系统(源代码+系统+答辩PPT)
收藏
资源目录
压缩包内文档预览：
编号：149910720
类型：共享资源
大小：660.37KB
格式：RAR
上传时间：2021-10-10
上传人：好资料QQ****51605
认证信息
个人认证
孙**（实名认证）
江苏
IP属地：江苏
20
积分
- 关 键 词：
-
VB
开发
交互式
CAD
系统
源代码
答辩
PPT
- 资源描述：
-
VB用VB开发交互式CAD系统(源代码+系统+答辩PPT),VB,开发,交互式,CAD,系统,源代码,答辩,PPT
- 内容简介：
-
1.图元的变换（1）直线段的几何变换直线段的平移变换Private Sub CGElement_Move(basePos As Position, desPos As Position) Dim xx As Double, yy As Double 计算横向移动的距离和纵向移动的距离 xx = desPos.x - basePos.x yy = desPos.y - basePos.y Set m_pLineBegin = m_pLineBegin.pntMove(xx, yy) Set m_pLineEnd = m_pLineEnd.pntMove(xx, yy)End Sub（2）直线段的旋转变换直线段的旋转变换Private Sub CGElement_Rotate(basePos As Position, Angle As Double) Set m_pLineBegin = m_pLineBegin.pntRotate(basePos, Angle) Set m_pLineEnd = m_pLineEnd.pntRotate(basePos, Angle)End Sub2多义线的几何变换（1） 多义线的平移变换Private Sub CGElement_Move(basePos As Position, desPos As Position) Dim xx As Double, yy As Double Dim i As Integer Dim point As New Position Dim MoveedPoints(1 To 100) As New Position xx = desPos.x - basePos.x yy = desPos.y - basePos.y For i = m_intPLinePointNum To 1 Step -1 Set point = m_pPLPoints(m_ID_PLine, i) Set point = point.pntMove(xx, yy) Set MoveedPoints(i) = point Next i For i = 1 To m_intPLinePointNum Set m_pPLPoints(m_ID_PLine, i) = MoveedPoints(i) Next iEnd Sub（2） 多义线的旋转变换Private Sub CGElement_Rotate(basePos As Position, Angle As Double) Dim i As Integer Dim point As Position Dim RotatedPoints(1 To 100) As New Position For i = m_intPLinePointNum To 1 Step -1 Set point = m_pPLPoints(m_ID_PLine, i) Set point = point.pntRotate(basePos, Angle) Set RotatedPoints(i) = point Next i For i = 1 To m_intPLinePointNum Set m_pPLPoints(m_ID_PLine, i) = RotatedPoints(i) Next iEnd Sub3圆的几何变换（1）圆的平移变换圆的平移变换Private Sub CGElement_Move(basePos As Position, desPos As Position) Dim xx As Double, yy As Double xx = desPos.x - basePos.x yy = desPos.y - basePos.y Set m_pCenter = m_pCenter.pntMove(xx, yy) Set m_pCircleR = m_pCircleR.pntMove(xx, yy)End Sub（3） 圆的旋转变换圆的旋转变换Private Sub CGElement_Rotate(basePos As Position, Angle As Double) Set m_pCenter = m_pCenter.pntRotate(basePos, Angle) Set m_pCircleR = m_pCircleR.pntRotate(basePos, Angle)End Sub4. 圆弧的几何变换（1） 圆弧的平移变换圆弧的平移变换Private Sub CGElement_Move(basePos As Position, desPos As Position) Dim xx As Double, yy As Double xx = desPos.x - basePos.x yy = desPos.y - basePos.y Set m_pCenter = m_pCenter.pntMove(xx, yy) Set m_pBegin = m_pBegin.pntMove(xx, yy) Set m_pEnd = m_pEnd.pntMove(xx, yy)End Sub（2） 圆弧的旋转变换圆弧的旋转变换Private Sub CGElement_Rotate(basePos As Position, Angle As Double) Set m_pCenter = m_pCenter.pntRotate(basePos, Angle) Set m_pBegin = m_pBegin.pntRotate(basePos, Angle) Set m_pEnd = m_pEnd.pntRotate(basePos, Angle)End Sub2.3 图形变换交互功能的实现2.3.1 平移变换CMOVE类Cmove.clsOption ExplicitImplements CCommandDim intEntSelectedNum As Integer单击鼠标左键时发生Private Sub CCommand_LButtonDown(pPos As Position) Dim i As Integer Dim pGElement As CGElement Dim pLine As New CLine Dim pPLine As New CPolyLine Dim pCircle As New CCircle Dim pArc As New CArc 将绘图环境的绘图模式设置为6 DrawMain.picDraw.DrawMode = 6 intmStep记录鼠标左键的单击次数 intmStep = intmStep + 1 Select Case intmStep Case 1 Set ptBasePos = pPos Set ptDesPos = pPos 请输入平移的目标点： Case 2 Set ptDesPos = pPos Dim pTempLine As CLine Set pTempLine = New CLine 清除鼠标移动时留下的橡皮线 Set ptLineBegin = ptBasePos Set ptLineEnd = ptDesPos With pTempLine Set .pLineBegin = ptLineBegin Set .pLineEnd = ptLineEnd End With Set pGElement = pTempLine pGElement.Draw (edmNormal) Set pTempLine = Nothing 将绘图环境的绘图模式设置为13 DrawMain.picDraw.DrawMode = 13 如果选择集中有图元，将所有图元移动到目标位置并进行绘制 If SelEntityNum() 0 Then For Each pLine In SelLines Set pGElement = pLine With pGElement .Draw (edmDelete) 清除原来位置上的图元 Call .Move(ptBasePos, ptDesPos) 将图元移到目标位置 .Draw (edmSelect) 将图元绘制为选择模式 End With With pLine lines.Remove (Str(.ID_Line) Call lines.Add(.geLineWidth, .geLineStyle, .geColor, .ID_Line, .pLineBegin, .pLineEnd, Str(.ID_Line) End With Next For Each pPLine In SelPLines Set pGElement = pPLine With pGElement .Draw (edmDelete) Call .Move(ptBasePos, ptDesPos) .Draw (edmSelect) End With With pPLine Dim PLPoints(1 To 100, 1 To 100) As Position For i = 1 To .intPLinePointNum Set PLPoints(.ID_PLine, i) = .pPLPoints(.ID_PLine, i) Next i polylines.Remove (Str(.ID_PLine) Call polylines.Add(.intPLinePointNum, PLPoints, .geLineWidth, .geLineStyle, .geColor, .ID_PLine, Str(.ID_PLine) End With Next For Each pCircle In SelCircles Set pGElement = pCircle With pGElement .Draw (edmDelete) Call .Move(ptBasePos, ptDesPos) .Draw (edmSelect) End With With pCircle circles.Remove (Str(.ID_Circle) Call circles.Add(.geLineWidth, .geLineStyle, .geColor, .pCircleR, .pCenter, .ID_Circle, Str(.ID_Circle) End With Next For Each pArc In SelArcs Set pGElement = pArc With pGElement .Draw (edmDelete) Call .Move(ptBasePos, ptDesPos) .Draw (edmSelect) End With With pArc arcs.Remove (Str(.ID_Arc) Call arcs.Add(.geLineWidth, .geLineStyle, .geColor, .pCenter, .pBegin, .pEnd, .ID_Arc, Str(.ID_Arc) End With Next End If DrawMain.picDraw.DrawMode = 6 intmStep = 0 End SelectEnd Sub移动鼠标时发生Private Sub CCommand_MouseMove(pPos As Position) Dim i As Integer Dim pLine As New CLine Dim pPLine As New CPolyLine Dim pCircle As New CCircle Dim pArc As New CArc Dim pGElement As CGElement Select Case intmStep Case 0 请输入镜像的第二点： Case 1 Dim prepos As New Position Dim curpos As New Position Dim pTempLine1 As CLine Dim pTempLine2 As CLine Set pTempLine1 = New CLine Set pTempLine2 = New CLine Set prepos = ptDesPos Set curpos = pPos 清除上一次绘制的橡皮线 Set ptLineBegin = ptBasePos Set ptLineEnd = prepos With pTempLine1 Set .pLineBegin = ptLineBegin Set .pLineEnd = ptLineEnd End With Set pGElement = pTempLine1 pGElement.Draw (edmNormal) Set pTempLine1 = Nothing 绘当前位置的橡皮线 Set ptLineBegin = ptBasePos Set ptLineEnd = curpos With pTempLine2 Set .pLineBegin = ptLineBegin Set .pLineEnd = ptLineEnd End With Set pGElement = pTempLine2 pGElement.Draw (edmNormal) Set pTempLine2 = Nothing 设置橡皮线的终点为当前点 Set ptDesPos = pPos End SelectEnd Sub右击鼠标时发生Private Sub CCommand_RButtonDown(pPos As Position) Dim i As Integer Dim prepos As Position Set prepos = New Position Set prepos = ptDesPos Dim pGElement As CGElement If intmStep = 1 Then Dim pTempLine As CLine Set pTempLine = New CLine 清除上一个绘制的橡皮线 Set ptLineBegin = ptBasePos Set ptLineEnd = prepos With pTempLine Set .pLineBegin = ptLineBegin Set .pLineEnd = ptLineEnd End With Set pGElement = pTempLine pGElement.Draw (edmNormal) Set pTempLine = Nothing End If intmStep = 0 请输入移动的起始点: End SubPrivate Sub Class_Initialize()End Sub2.3.2旋转变换Rotate.clsOption ExplicitImplements CCommandDim pGElement As New CGElement单击鼠标左键时发生Private Sub CCommand_LButtonDown(pPos As Position) Dim i As Integer Dim Angle As Double Dim pLine As New CLine Dim pPLine As New CPolyLine Dim pCircle As New CCircle Dim pArc As New CArc Dim pGElement As CGElement DrawMain.picDraw.DrawMode = 6 intmStep变量记录单击鼠标左键的次数 intmStep = intmStep + 1 Select Case intmStep Case 1 Set ptBasePos = pPos Set ptDesPos = pPos 请输入第二点： Case 2 Set ptDesPos = pPos Dim pTempLine As CLine Set pTempLine = New CLine 清除鼠标移动时留下的橡皮线 Set ptLineBegin = ptBasePos Set ptLineEnd = ptDesPos With pTempLine Set .pLineBegin = ptLineBegin Set .pLineEnd = ptLineEnd End With Set pGElement = pTempLine pGElement.Draw (edmNormal) Set pTempLine = Nothing 设置绘图模式为13 DrawMain.picDraw.DrawMode = 13 如果选择集不为空，将选择集中的图元旋转到目标位置并进行绘制 If SelEntityNum() 0 Then For Each pLine In SelLines Set pGElement = pLine With pGElement .Draw (edmDelete) 清除原来位置上的图元 Angle = GetAngle(ptBasePos, ptDesPos) Call .Rotate(ptBasePos, Angle) 将图元旋转到目标位置 .Draw (edmSelect) End With With pLine lines.Remove (Str(.ID_Line) Call lines.Add(.geLineWidth, .geLineStyle, .geColor, .ID_Line, .pLineBegin, .pLineEnd, Str(.ID_Line) End With Next For Each pPLine In SelPLines Set pGElement = pPLine With pGElement .Draw (edmDelete) Angle = GetAngle(ptBasePos, ptDesPos) Call .Rotate(ptBasePos, Angle) 将图元移到目标位置 .Draw (edmSelect) End With With pPLine Dim PLPoints(1 To 100, 1 To 100) As Position For i = 1 To .intPLinePointNum Set PLPoints(.ID_PLine, i) = .pPLPoints(.ID_PLine, i) Next i polylines.Remove (Str(.ID_PLine) Call polylines.Add(.intPLinePointNum, PLPoints, .geLineWidth, .geLineStyle, .geColor, .ID_PLine, Str(.ID_PLine) End With Next For Each pCircle In SelCircles Set pGElement = pCircle With pGElement .Draw (edmDelete) Angle = GetAngle(ptBasePos, ptDesPos) Call .Rotate(ptBasePos, Angle) 将图元移到目标位置 .Draw (edmSelect) End With With pCircle circles.Remove (Str(.ID_Circle) Call circles.Add(.geLineWidth, .geLineStyle, .geColor, .pCircleR, .pCenter, .ID_Circle, Str(.ID_Circle) End With Next For Each pArc In SelArcs Set pGElement = pArc With pGElement .Draw (edmDelete) Angle = GetAngle(ptBasePos, ptDesPos) Call .Rotate(ptBasePos, Angle) 将图元移到目标位置 .Draw (edmSelect) End With With pArc arcs.Remove (Str(.ID_Arc) Call arcs.Add(.geLineWidth, .geLineStyle, .geColor, .pCenter, .pBegin, .pEnd, .ID_Arc, Str(.ID_Arc) End With Next End If DrawMain.picDraw.DrawMode = 6 intmStep = 0 End Select End SubPrivate Sub CCommand_MouseMove(pPos As Position) Dim i As Integer Dim pGElement As CGElement Select Case intmStep Case 0 请输入旋转的基点： Case 1 Dim prepos As New Position Dim curpos As New Position Dim pTempLine1 As CLine Dim pTempLine2 As CLine Set pTempLine1 = New CLine Set pTempLine2 = New CLine Set prepos = ptDesPos Set curpos = pPos 清除上一次绘制的橡皮线 Set ptLineBegin = ptBasePos Set ptLineEnd = prepos With pTempLine1 Set .pLineBegin = ptLineBegin Set .pLineEnd = ptLineEnd End With Set pGElement = pTempLine1 pGElement.Draw (edmNormal) Set pTempLine1 = Nothing 在当前位置绘制橡皮线 Set ptLineBegin = ptBasePos Set ptLineEnd = curpos With pTempLine2 Set .pLineBegin = ptLineBegin Set .pLineEnd = ptLineEnd End With Set pGElement = pTempLine2 pGElement.Draw (edmNormal) Set pTempLine2 = Nothing 设置橡皮线的终点为当前点 Set ptDesPos = pPos End SelectEnd Sub右击鼠标时发生Private Sub CCommand_RButtonDown(pPos As Position) Dim i As Integer Dim pGElement As CGElement Dim prepos As Position Set prepos = New Position Set prepos = ptDesPos If intmStep = 1 Then Dim pTempLine As CLine Set pTempLine = New CLine 清除上一个绘制的橡皮线 Set ptLineBegin = ptBasePos Set ptLineEnd = prepos With pTempLine Set .pLineBegin = ptLineBegin Set .pLineEnd = ptLineEnd End With Set pGElement = pTempLine pGElement.Draw (edmNormal) Set pTempLin
- 温馨提示:
1: 本站所有资源如无特殊说明，都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
2: 本站的文档不包含任何第三方提供的附件图纸等，如果需要附件，请联系上传者。文件的所有权益归上传用户所有。
3.本站RAR压缩包中若带图纸，网页内容里面会有图纸预览，若没有图纸预览就没有图纸。
4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
5. 人人文库网仅提供信息存储空间，仅对用户上传内容的表现方式做保护处理，对用户上传分享的文档内容本身不做任何修改或编辑，并不能对任何下载内容负责。
6. 下载文件中如有侵权或不适当内容，请与我们联系，我们立即纠正。
7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。
人人文库网所有资源均是用户自行上传分享，仅供网友学习交流，未经上传用户书面授权，请勿作他用。
川公网安备: 51019002004831号